HOME > エクセルVBA > サンプル > WindowsAPI

WindowsAPI


【ファイル名】WindowsAPI.xlsm
【バージョン】Ver 1.0.7.0
【作成日】2015年02月19日
【更新日】2021年06月10日
【動作確認】Windows 10 32ビットと64ビット
【必要なソフト】Microsoft Excel 2010
【ダウンロード】WindowsAPI.zip (Excel 2010以降、コンパイラ定数のWin64を使用します)
【説明】Windows APIのサンプルです。
メニュー

私はWindows APIは詳しくありません。間違いがあるかもしれません。
Windows APIを使って開発する時はExcelが異常終了する事もありますので実行する前にファイルを保存しましょう。
ByValとByRef、データの型が違うとメモリを破壊する場合があります。
Webで公開しているサンプルは、いまだにWindos 95用が多いです。またWin64は間違いが多いので注意しましょう。(特にLongとLongPtr)
注意 文字列を使う"A"で終わる名前の関数は、Shift-JISに変換できない文字コードが化けます。
Windows NTやWindows 2000以降のユニコードのOSで文字列を使う関数は、"W"で終わる名前で、String型は使いません。
データ型の詳細は「C、C++の型とデータータイプ」を参照してください。

Windows APIを使用するために
主な変数型の対応表
C/C++ VBA
char、BYTE Byte (charは符号あり)
ATOM、short、unsigned short、WORD Integer (ATOM、unsigned short、WORDは符号なし)
BOOL Long (Win32以降、VBAのBooleanは16bitなので違います。) 値は偽が0、真が0以外です。
int、INT、long、unsigned long、DWORD、HFILE、HRESULT Long (unsigned long、DWORD、HRESULTは符号なし)
HANDLE、WPARAM、LPARAM、LRESULT、SIZE_T Win32はLong、Win64はLongPtr(LongLong)。(WPARAM、SIZE_Tは符号なし) HANDLEは値渡し(ByVal)です。
PSTR、PCSTR、PCTSTR、PCWSTR、LPSTR、LPCSTR、LPCTSTR、LPCWSTR "W"で終わる名前のUnicodeの関数の文字列型の引数は、Win32ではLong、Win64はLongPtr(LongLong)にし、十分なメモリを確保したヌルで終わる文字列のポインターをStrPtr関数で渡します。
"A"で終わる名前のANSIの関数の文字列型の引数は、String型です。(Windows 95用で現在は使いません)
どちらも値渡しなので、ByVal を忘れないでください。
 char、unsigned short、WORD、unsigned long、DWORDはVBAの変数と符号が違うため、値によっては変換する必要があります。VBAのIntegerとCのUnsigned ShortとWORDの変換の例は「ConvertModule」を参照してください。
 pか、lpで始まる変数名のほとんどはポインターです。hで始まる変数名の多くは、HANDLEです。HFILEとHRESULTはVBAのLong型です。
 FARPROCは AddressOf 演算子で標準モジュールの関数のポインタを渡してください。
 型の詳細は「C、C++の型とデータータイプ」を参照してください。

マイクロソフトのサイトのリンク

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="Windows API">
          <box id="Box1" boxStyle="vertical">
              <button id="BrowseForFolderButton" label="フォルダの参照ダイアログ(&B)" supertip="フォルダの参照ダイアログを表示します。" imageMso="Folder" onAction="onAction" />
              <button id="MoveTrashSelectFileButton" label="ファイルをゴミ箱に移動する(&F)" supertip="選択したファイルをゴミ箱に移動します。" imageMso="FilePermission" onAction="onAction" />
              <button id="MoveTrashSelectFolderButton" label="フォルダをゴミ箱に移動する(&M)" supertip="選択したフォルダをゴミ箱に移動します。" imageMso="Delete" onAction="onAction" />
          </box>
          <separator id="separator1" />
          <box id="Box2" boxStyle="vertical">
              <button id="GetTickCountButton" label="GetTickCount(&T)" supertip="パソコンを起動してからの時間を表示します。(時間はオーバーフローします)" imageMso="StartAfterPrevious" onAction="onAction" />
              <button id="SleepButton" label="Sleep(&S)" supertip="3秒の間、処理を待ちます。" imageMso="StartAfterPrevious" onAction="onAction" />
              <button id="Display_LastDllErrorButton" label="LastDllError(&E)" supertip="Dllの最後のエラーを表示します。(ErrオブジェクトのLastDllErrorプロパティ)" imageMso="CancelRequest" onAction="onAction" />
          </box>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上
下記のマイクロソフトのサイトを参考にしました。
【外部リンク】SHGetPathFromIDListW functionSHBrowseForFolderW functionSleep functionSHFileOperationW functionGetTickCount64 functionGetComputerNameW functionGetUserNameW functionGetTempPathW function

C言語のヘッダーファイルの文字列の最大長の定義(#define)はヌルを含む場合と、含まない場合があります。人によっては安全のためにすべてに、+1します。

WindowsAPIModule
' WindowsAPIModule
Option Explicit
Option Base 1
Option Compare Binary

Const BIF_RETURNONLYFSDIRS As Long = &H1
Const FO_DELETE As Long = &H3
Const FOF_ALLOWUNDO As Integer = &H40 ' ごみ箱に送る

#If Win64 Then ' 64ビット
' https://docs.microsoft.com/en-us/windows/win32/api/shellapi/ns-shellapi-shfileopstructw
  Type SHFILEOPSTRUCTW
    hwnd As LongPtr
    wFunc As Long
    pFrom As LongPtr
    pTo As LongPtr
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As LongPtr
    lpszProgressTitle As LongPtr
  End Type
  
' https://docs.microsoft.com/en-us/windows/win32/api/shlobj_core/ns-shlobj_core-browseinfow
  Type BROWSEINFOW
    hwndOwner As LongPtr
    pidlRoot As LongPtr
    pszDisplayName As LongPtr
    lpszTitle As LongPtr
    ulFlags As Long
    lpfn As LongPtr
    lParam As LongPtr
    iImage As Long
  End Type
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/shlobj_core/nf-shlobj_core-shgetpathfromidlistw
  Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListW" (ByVal pidl As LongPtr, ByVal pszPath As LongPtr) As Long
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/shlobj_core/nf-shlobj_core-shbrowseforfolderw
  Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderW" (lpBrowseInfo As BROWSEINFOW) As LongPtr
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/synchapi/nf-synchapi-sleep
  Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/shellapi/nf-shellapi-shfileoperationw
  Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationW" (lpFileOp As SHFILEOPSTRUCTW) As Long
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/sysinfoapi/nf-sysinfoapi-gettickcount64
  Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount64" () As LongLong ' 32bitはGetTickCountを使用します。
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/winbase/nf-winbase-getcomputernamew
  Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameW" (ByVal lpBuffer As LongPtr, nSize As Long) As Long
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/winbase/nf-winbase-getusernamew
  Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameW" (ByVal lpBuffer As LongPtr, nSize As Long) As Long
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/fileapi/nf-fileapi-gettemppathw
  Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathW" (ByVal nBufferLength As Long, ByVal lpBuffer As LongPtr) As Long
#Else
  Type SHFILEOPSTRUCTW
    hwnd As Long
    wFunc As Long
    pFrom As Long
    pTo As Long
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As Long
  End Type
  
  Type BROWSEINFOW
    hwndOwner As Long
    pidlRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
  End Type
  
  Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListW" (ByVal pidl As Long, ByVal pszPath As Long) As Long
  Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderW" (lpBrowseInfo As BROWSEINFOW) As Long
  Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
  Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationW" (lpFileOp As SHFILEOPSTRUCTW) As Long
  ' https://docs.microsoft.com/en-us/windows/desktop/api/sysinfoapi/nf-sysinfoapi-gettickcount
  Declare Function GetTickCount Lib "kernel32.dll" () As Long
  Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameW" (ByVal lpBuffer As Long, nSize As Long) As Long
  Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameW" (ByVal lpBuffer As Long, nSize As Long) As Long
  Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathW" (ByVal nBufferLength As Long, ByVal lpBuffer As Long) As Long
#End If

Const MAX_PATH = 260& ' パス名の最大文字数

' 指定したヌルで終わる文字列から、vbNullCharの左側の文字列を取得します。
Public Function StrVBA(ByVal EndNullString As String) As String
  Dim p As Long
  
  p = InStr(1, EndNullString, vbNullChar)
  If p > 0 Then
    StrVBA = Left(EndNullString, p - 1)
  Else
    StrVBA = EndNullString ' ■ vbNullCharがない場合は引数をそのまま返します。
'    StrVBA = vbNullString ' ■ 必要に応じて変更してください。
  End If
End Function
' フォルダの選択ダイアログを表示し、フォルダ名を取得します。
Function BrowseForFolder(Optional msg As String = "フォルダを選択してください。") As String ' 戻り値はフォルダ名、キャンセルの場合はvbNullStringを返します。
  Dim BI As BROWSEINFOW
  Dim pszPath  As String
  Dim ret As Long

#If Win64 Then ' 64ビット
  Dim pidl As LongPtr
#Else
  Dim pidl As Long
#End If
BI.hwndOwner = Application.hwnd
  BI.pidlRoot = 0&
  BI.lpszTitle = StrPtr(msg) ' フォルダのツリーの上のラベルのキャプションです。ウィンドウのタイトルではありません!
  BI.ulFlags = BIF_RETURNONLYFSDIRS
  pidl = SHBrowseForFolder(BI)
  pszPath = String(MAX_PATH, vbNullChar)
  ret = SHGetPathFromIDList(pidl, StrPtr(pszPath))
  If ret <> 0 Then
    BrowseForFolder = StrVBA(pszPath)
  Else
    BrowseForFolder = vbNullString
  End If
End Function
' 選択したフォルダを表示します。
Sub BrowseForFolderSample()
  Dim FolderName As String
  
  FolderName = BrowseForFolder()
  If FolderName <> vbNullString Then MsgBox Prompt:=FolderName, Buttons:=vbInformation, Title:="選択したフォルダ名"
End Sub
' フォルダかファイルをごみ箱に移動します。
Public Function MoveTrash(Name As String) As Boolean ' 返値のTrueは成功、Falseはエラー
  Dim SHFO As SHFILEOPSTRUCTW
  Dim fName As String
  
  fName = String(MAX_PATH, vbNullChar)
  fName = Name & vbNullChar & vbNullChar
  With SHFO
    .hwnd = Application.hwnd
    .wFunc = FO_DELETE
    .pFrom = StrPtr(fName)
    .fFlags = FOF_ALLOWUNDO
  End With
  MoveTrash = (SHFileOperation(SHFO) = 0) ' 0以外はエラー
End Function
' ダイアログで選択したファイルをゴミ箱に移動します。
Sub MoveTrashSelectFile()
  Dim FileName As Variant
  
  FileName = Application.GetOpenFilename(Title:="削除するファイルを選択してください。", ButtonText:="削除")
  If TypeName(FileName) = "Boolean" Then Exit Sub
  If MoveTrash(CStr(FileName)) = False Then MsgBox "ファイルを削除できませんでした。", vbExclamation
End Sub
' ダイアログで選択したフォルダをゴミ箱に移動します。
Sub MoveTrashSelectFolder()
  Dim FolderName As String
  
  FolderName = BrowseForFolder("削除するフォルダを選択してください。")
  If FolderName = vbNullString Then Exit Sub
  If MoveTrash(FolderName) = False Then MsgBox "フォルダを削除できませんでした。", vbExclamation
End Sub
' Windows APIの最後のエラーを表示します。
Sub Display_LastDllError()
  MsgBox Prompt:="Err.LastDllError = " & Err.LastDllError, Buttons:=vbInformation, Title:="Windows APIの最後のエラー"
End Sub
' Sleepのサンプル
Sub SleepSample()
  Application.Cursor = xlWait
  Sleep 3000 ' 3秒待つ
  Application.Cursor = xlDefault
  MsgBox Prompt:="3秒たちました。", Buttons:=vbInformation
End Sub
Sub WaitSample() ' Application.Waitのサンプル
  Application.Cursor = xlWait
  Application.Wait Now + TimeValue("00:00:03") ' 3秒待つ
  Application.Cursor = xlDefault
  MsgBox Prompt:="3秒たちました。", Buttons:=vbInformation
End Sub
' システムを起動した後の経過時間を表示します。(ミリ秒)
' 【注意】Windowsを終了しないで連続して動作させると経過時間は0に戻ります。(32bitは、49.7日間)
Sub GetTickCountSample()
  MsgBox Prompt:="経過時間 " & GetTickCount() & " ミリ秒", Buttons:=vbInformation, Title:="システムを起動した後の経過時間"
End Sub
' ローカル コンピューター名を表示します。
Sub GetComputerNameSample()
  Const MAX_COMPUTERNAME_LENGTH = 31 + 1 ' Windowsのコンピューター名の最大数にヌルの文字数を足します。
  Dim buf As String
  Dim msg As String
  Dim nSize As Long
  
  buf = String(MAX_COMPUTERNAME_LENGTH, vbNullChar)
  nSize = Len(buf)
  If GetComputerName(StrPtr(buf), nSize) = 0 Then
    MsgBox Prompt:="コンピューター名を取得できませんでした。", Buttons:=vbExclamation + vbSystemModal, Title:="エラー"
  Else
    msg = "コンピューター名:" & StrVBA(buf)
    msg = msg & vbNewLine & vbNewLine & "文字数:" & nSize
    MsgBox Prompt:=msg, Buttons:=vbInformation, Title:="情報"
  End If
End Sub
' ユーザー名を表示します。
Sub GetUserNameSample()
  Dim buf As String
  Dim msg As String
  Dim nSize As Long
  
  buf = String(256, vbNullChar) ' 文字列の最大数が分からないので、256にしました。(ユーザアカウント文字数の最大長は25文字?)
  nSize = Len(buf)
  If GetUserName(StrPtr(buf), nSize) = 0 Then
    MsgBox Prompt:="ユーザー名を取得できませんでした。", Buttons:=vbExclamation + vbSystemModal, Title:="エラー"
  Else
    msg = "ユーザー名:" & StrVBA(buf)
    msg = msg & vbNewLine & vbNewLine & "文字数:" & nSize - 1 ' 文字数はNULLを含めるため、-1
    MsgBox Prompt:=msg, Buttons:=vbInformation, Title:="情報"
  End If
End Sub
' Tempフォルダーのパス名を表示します。
Sub GetTempPathSample()
  Dim buf As String ' VBAのString型はユニコード
  Dim nSize As Long
  
  buf = String(MAX_PATH + 1, vbNullChar) ' 必要なメモリを確保してヌルで初期化する
  nSize = Len(buf) ' 確保した文字数(この関数はバイト数ではないので、LenBは使わない)
  If GetTempPath(nSize, StrPtr(buf)) = 0 Then ' StrPtr 関数でポインターを渡す
    MsgBox Prompt:="Tempフォルダーのパス名を取得できませんでした。", Buttons:=vbExclamation + vbSystemModal, Title:="エラー"
  Else
    buf = Left(buf, InStr(buf, vbNullChar) - 1) ' ヌルの前までの文字列にする
    MsgBox Prompt:="Tempフォルダー:" & buf, Buttons:=vbInformation, Title:="情報"
  End If
End Sub
このページの上

IfModule
Option Explicit
' コンパイラー定数を検証します。

#Const DEBUGMODE = 1

Sub Test()
' イミディエイト ウィンドウを表示するには、「表示」の「イミディエイト ウィンドウ」メニューを実行します。ショートカットキーは、Ctrl+Gです。

#If Comment = "YES" Then
  Commentは定義していないため、コンパイルされません。よってエラーになりません。
  だからといってコメントの換わりにするには推奨できません。
#End If

#If DEBUGMODE = 1 Then
  Debug.Print "DEBUGMODEです。" ' #Const DEBUGMODE = 1 と宣言したので実行します。
#Else
  Debug.Print "DEBUGMODEではありません。" ' #Const DEBUGMODE = 0 にすると、実行します。
#End If

#If Mac Then
  Debug.Print "Macです。"
#Else
  Debug.Print "Macではありません。" ' Windows
#End If

#If Win32 Then
  Debug.Print "Win64か、あるいはWin32です。" ' 【注意】Win64の場合も、Win32がTrueになります。
#Else
  Debug.Print "Win64、Win32ではありません。"
#End If

#If Win128 Then ' Win128は宣言してませんが、エラーにはなりません、Falseです。
  Debug.Print "Win128です。"
#ElseIf Win64 Then
  Debug.Print "Win64です。"
#ElseIf Win32 Then
  Debug.Print "Win32です。"
#ElseIf Win16 Then
  Debug.Print "Win16です。"
#Else
  Debug.Print "Win128、Win64、Win32、Win16ではありません。"
#End If


#If VBA6 Then
  Debug.Print "VBA7か、あるいはVBA6です。" ' 【注意】VBA7の場合も、VBA6がTrueになります。
#Else
  Debug.Print "VBA7、VBA6ではありません。"
#End If

#If VBA8 Then ' VBA8は宣言してませんが、エラーにはなりません、Falseです。
  Debug.Print "VBA8です。"
#ElseIf VBA7 Then
  Debug.Print "VBA7です。" ' Office 2010, 2013, 2016, 2019です。
#ElseIf VBA6 Then
  Debug.Print "VBA6です。" ' Office 2000, 2002, 2003, 2007です。
#ElseIf VBA5 Then
  Debug.Print "VBA5です。" ' Office 97(Word 98を含む)です。
#Else
  Debug.Print "VBA8、VBA7、VBA6、VBA5ではありません。"
#End If

' 良くWEBで見られるがバージョンアップして、もしVBA7がFalseになると64ビットが動作しません。(慣例ではVBA8になってもVBA7はTrueですが)
' 現在は問題なくても修正が必要になるかもしれません。
#If VBA7 And Win64 Then
  Debug.Print "VBA7 And Win64"
#Else
  Debug.Print "Not VBA7 or Not Win64" ' 【注意】バージョンアップして、もしVBA7がFalseになると64ビットが動作できなくなります。
#End If

' Office 64ビットと32ビットで共用する場合
#If Win64 Then ' Office 64ビットの場合は、
  Debug.Print "Win64"
  Debug.Print "Declareの後にPtrSafeが必須です。"
  Debug.Print "必要に応じてLongPtr、LongLongを使用します。"
#Else ' Office 32ビットの場合は、
  Debug.Print "Win32"
  Debug.Print "VBA7はPtrSafeが必要ありません。(VBA6はエラー)"
  Debug.Print "VBA7はLongPtrがLongになるが、VBA6はエラーです。LongLongは使用できません。"
#End If

End Sub
このページの上


RibbonModule
Option Explicit

Sub onAction(control As IRibbonControl) ' ボタンの処理
  Err.Clear ' エラーをクリアーする
  On Error GoTo ErrorHandle ' ◆ エラー処理ルーチンを有効にします。Windows API のエラーはトラップできません。
' コマンドにより処理
  Select Case control.ID ' 複数のボタンで共通して使うためIDにより分岐
    Case "BrowseForFolderButton"
      Call BrowseForFolderSample
    Case "MoveTrashSelectFileButton"
      Call MoveTrashSelectFile
    Case "MoveTrashSelectFolderButton"
      Call MoveTrashSelectFolder
    Case "Display_LastDllErrorButton"
      Call Display_LastDllError
    Case "SleepButton"
      Call SleepSample
    Case "GetTickCountButton"
      Call GetTickCountSample
    Case "GetComputerNameButton"
      Call GetComputerNameSample
    Case "GetUserNameButton"
      Call GetUserNameSample
    Case "GetTempPathButton"
      Call GetTempPathSample
    Case Else
      MsgBox Prompt:="コントロールID """ & control.ID & """ の処理がありません。" & vbNewLine & vbNewLine & "作者にご連絡ください。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
  End Select
  
  Exit Sub
' <---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
ErrorHandle:
  MsgBox Prompt:=Err.Number & ": " & Err.Description, Buttons:=vbCritical + vbSystemModal, Title:="エラー"
End Sub
このページの上


ConvertModule
Option Explicit

' VBAのLongからUnsigned ShortやWORDの値に変換します。
' VBAのIntegerは、-32,768から32,767。 C/C++のUnsigned ShortとWORDは、 0から65,535です。
Function SetUnsignedShort(v As Long) As Integer
  If v > 32767 Then
    SetUnsignedShort = CInt(v - &H10000) ' 負の値にする
  Else
    SetUnsignedShort = v
  End If
End Function

Sub Test_SetUnsignedShort()
  Debug.Print "0", SetUnsignedShort(0)
  Debug.Print "1", SetUnsignedShort(1)
  Debug.Print "32767", SetUnsignedShort(32767)
  Debug.Print "32768", SetUnsignedShort(32768)
  Debug.Print "65534", SetUnsignedShort(65534)
  Debug.Print "65535", SetUnsignedShort(65535)
End Sub

' Unsigned ShortやWORDからVBAのLongの値に変換します。
' VBAのIntegerは、-32,768から32,767。 C/C++のUnsigned ShortとWORDは、 0から65,535です。
Function GetUnsignedShort(v As Integer) As Long
  GetUnsignedShort = CLng(v) And &HFFFF& ' マイナス符号を削除する
End Function

Sub Test_GetUnsignedShort()
  Debug.Print "0", GetUnsignedShort(0)
  Debug.Print "1", GetUnsignedShort(1)
  Debug.Print "32766", GetUnsignedShort(32766)
  Debug.Print "32767", GetUnsignedShort(32767)
  Debug.Print "-32767", GetUnsignedShort(-32767)
  Debug.Print "-32768", GetUnsignedShort(-32768)
  Debug.Print "-1", GetUnsignedShort(-1)
  Debug.Print "-2", GetUnsignedShort(-2)
End Sub
このページの上


OtherModule
Option Explicit

Private Type myType
  b As Byte
  i As Integer
  l As Long
End Type

#If Win64 Then
  ' https://docs.microsoft.com/ja-jp/windows/desktop/api/sysinfoapi/nf-sysinfoapi-getcomputernameexw
  Private Declare PtrSafe Function GetComputerNameEx Lib "kernel32" Alias "GetComputerNameExW" (ByVal NameType As Long, ByVal lpBuffer As LongPtr, lpnSize As Long) As Long
#Else
  Private Declare Function GetComputerNameEx Lib "kernel32" Alias "GetComputerNameExW" (ByVal NameType As Long, ByVal lpBuffer As LongPtr, lpnSize As Long) As Long
'  Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameW" (ByVal lpBuffer As Long, nSize As Long) As Long
#End If

' https://docs.microsoft.com/ja-jp/windows/desktop/api/sysinfoapi/ne-sysinfoapi-_computer_name_formathttps://docs.microsoft.com/ja-jp/windows/desktop/api/sysinfoapi/ne-sysinfoapi-_computer_name_format
Public Enum COMPUTER_NAME_FORMAT
  ComputerNameNetBIOS
  ComputerNameDnsHostname
  ComputerNameDnsDomain
  ComputerNameDnsFullyQualified
  ComputerNamePhysicalNetBIOS
  ComputerNamePhysicalDnsHostname
  ComputerNamePhysicalDnsDomain
  ComputerNamePhysicalDnsFullyQualified
  ComputerNameMax
End Enum

' コンピューター名を取得する
Public Function Get_ComputerNameEx(Optional ComputerNameType As COMPUTER_NAME_FORMAT = COMPUTER_NAME_FORMAT.ComputerNameNetBIOS) As String
  Const MAX_COMPUTERNAME_LENGTH = 31 + 1 ' Windowsのコンピューター名の最大数にヌルの文字数を足します。
  Dim ComputerName As String
  Dim lpnSize As Long
  Dim ret As Long

  ComputerName = String(MAX_COMPUTERNAME_LENGTH, vbNullChar)
  lpnSize = Len(ComputerName)
  ret = GetComputerNameEx(ComputerNameType, StrPtr(ComputerName), lpnSize)
  If ret <> 0 Then
      Get_ComputerNameEx = StrVBA(ComputerName)
  Else
    Get_ComputerNameEx = ""
  End If
End Function
Private Sub Show_ComputerNameEx()
  MsgBox Prompt:="コンピューター名:" & Get_ComputerNameEx(COMPUTER_NAME_FORMAT.ComputerNameNetBIOS), Buttons:=vbInformation, Title:="情報"
End Sub

Sub StrPtr_Sample() ' StrPtrで固定長文字列は一時的に作成した可変長文字列のアドレスを取得します。
  Dim v1 As String
  Dim v2 As String
  Dim f1 As String * 256
  Dim f2 As String * 256
  
  v1 = "v1"
  v2 = "v2"
  f1 = "f1"
  f2 = "f2"
  
  Debug.Print "StrPtr(v1)=" & StrPtr(v1)
  Debug.Print "StrPtr(v2)=" & StrPtr(v2)
  Debug.Print "StrPtr(f1)=" & StrPtr(f1) ' StrPtrで固定長文字列は一時的に作成した可変長文字列のアドレスを取得します。
  Debug.Print "StrPtr(f2)=" & StrPtr(f2) ' 上のf1と同じアドレスになりますので注意してください。
' 実行結果の例.数値は環境により異なります。
' StrPtr(v1) = 175781884
' StrPtr(v2) = 175780684
' StrPtr(f1) = 175455764
' StrPtr(f2) = 175455764
End Sub

Sub Test_String() ' VBAのString型は参照です。
  Dim s As String
  
  s = String(255, vbNullChar)
  Debug.Print StrPtr(s), Len(s) ' 168203444     255
  
  s = "abc" & vbNullChar ' 【注意】StrPtr(s)の戻り値は前回と同じではありません。
  Debug.Print StrPtr(s), Len(s) ' 168300708     4
End Sub

Sub Boolean_Sample() ' C言語のBOOLは、VBAのBooleanではありません。
  Dim bBoolean As Boolean
  Dim lLong As Long
  Dim str As String
  Dim t As myType
  
  ' Windows APIの偽は0、真は0以外です。VBAの True は使いません。
  Debug.Print "True = " & CInt(True)   ' True = -1
  Debug.Print "False = " & CInt(False) ' False = 0
  
  ' Win32以降、C言語のBOOLは4バイト(32bit)で、VBAのLongです。VBAのBooleanは2バイト(16bit)なので違います。
  Debug.Print "LenB(bBoolean) = " & LenB(bBoolean) ' LenB(bBoolean) = 2
  Debug.Print "LenB(lLong) = " & LenB(lLong)       ' LenB(lLong) = 4
  
  ' VBAはユニコードなのでバイト数は文字数の2倍です。
  ' 文字数は、Len、バイト数は、LenB 関数を使います。
  str = "あいう"
  Debug.Print "Len(str) = " & Len(str)   ' Len(str) = 3
  Debug.Print "LenB(str) = " & LenB(str) ' LenB(str) = 6
  
  ' ユニコードなので、vbNullCharは2バイトです。
  Debug.Print "LenB(vbNullChar) = " & LenB(vbNullChar) ' LenB(vbNullChar) = 2
  Debug.Print "StrPtr(vbNullString) = " & StrPtr(vbNullString) ' StrPtr(vbNullString) = 0
  
'  ユーザー定義型のセグメントは4バイト(32ビット)です。メモリは4の倍数のバイト数になります。
'  Private Type myType
'    b As Byte
'    i As Integer
'    ● ここに1バイトの空きメモリが発生します。(Byteは1バイト、Integerは2バイト)
'    l As Long
'  End Type
  Debug.Print "LenB(t) = " & LenB(t) ' LenB(t) = 8 正
  Debug.Print "Len(t) = " & Len(t)   ' Len(t) = 7 ● これはダメ
End Sub
このページの上


ByteArrayModule
このサンプルは文字列の引数にString型ではなく、Byte型の配列の先頭の要素を参照渡しすることで、配列の先頭アドレスを渡してます。
Option Explicit

Const MAX_PATH = 260& ' パス名の最大文字数

#If Win64 Then
  ' https://docs.microsoft.com/en-us/windows/desktop/api/fileapi/nf-fileapi-gettemppathw
  ' Byte型の配列の先頭アドレスを渡すので引数の lpBuffer に ByVal がありません。
  Declare PtrSafe Function GetTempPath Lib "kernel32" Alias "GetTempPathW" (ByVal nBufferLength As Long, lpBuffer As Byte) As Long
#Else
  Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathW" (ByVal nBufferLength As Long, lpBuffer As Byte) As Long
#End If

' Tempフォルダーのパス名を表示します。このサンプルは文字列の引数にString型ではなく、Byte型の配列の先頭アドレスを渡します。
Sub GetTempPathSample_Byte()
  Dim bStr(0 To (MAX_PATH + 1) * 2 - 1) As Byte ' ● Unicode は文字数の2倍のバイト数が必要
  Dim buf As String
  Dim i As Long
  Dim nSize As Long ' 文字数
  
  For i = LBound(bStr) To UBound(bStr)
    bStr(i) = 0
  Next
  
  nSize = MAX_PATH + 1 ' ● この関数はバイト数ではなく、文字数を要求しています。
  If GetTempPath(nSize, bStr(0)) = 0 Then ' 配列の先頭の要素を参照渡しすることで、配列の先頭アドレスを渡してます。
    MsgBox Prompt:="Tempフォルダーのパス名を取得できませんでした。", Buttons:=vbExclamation + vbSystemModal, Title:="エラー"
  Else
    buf = bStr ' 文字列型に代入する
    buf = StrVBA(buf) ' ヌルを除く
    MsgBox Prompt:="Tempフォルダー:" & buf, Buttons:=vbInformation, Title:="情報"
  End If
End Sub
このページの上
ファイルを分割したのでWindows APIでパス名からディレクトリ名、ファイル名を取得するサンプルは「WindowsAPIPath」を参照してください。