VBA Windows API

The Windows API allows VBA to access functionalities of the Windows Operating System. Windows API procedures are declared in VBA and then called directly in VBA code or through a wrapper procedure written in VBA which manages usage of the Windows API procedure.

Microsoft has provided the VBA declarations for Windows API procedures to be used freely. Because VBA7 requires the PtrSafe keyword to be used in declarations and the LongLong and LongPtr types were added, there are two versions of the VBA Windows API declarations provided by Microsoft.

VBA Windows API Declarations:

Declaring Windows API Functions

To declare Windows API procedures use the Declare statement. Specify the location of the procedure using the Lib keyword. To declare a procedure using an alias, specify the original name of the procedure as declared within the code resource using the Alias clause.

To make Windows API declarations compatible with VBA7, the PtrSafe keyword must be used with the Declare statement. To ensure compatibility with 32-bit and 64-bit platforms in VBA7, use the LongPtr type for all pointers and handles.

#If VBA7 Then
    Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
        ByVal pCaller As LongPtr, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As LongPtr, _
        ByVal lpfnCB As LongPtr) As LongPtr
#Else
    Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
        ByVal pCaller As Long, _
        ByVal szURL As String, _
        ByVal szFileName As String, _
        ByVal dwReserved As Long, _
        ByVal lpfnCB As Long) As Long
#End If

Wrapper Procedures

Sometimes calling a Windows API procedure directly from VBA code can complicate the VBA code. To mitigate this issue it is often helpful to write a wrapper procedure in VBA to handle all the details of calling the Windows API procedure.

Public Function WinAPIURLDownloadToFile(URL$, DownloadPath$) As Boolean

    '''Returns True if File Download Starts Successfully

    Dim FileDir$
    FileDir = Left$(DownloadPath, InStrRev(DownloadPath, "\"))

    'Validate download file path
    If Dir(FileDir, vbDirectory) = "" Then
        Err.Raise 76 'Path not found
    End If

    'Validate file does not already exist
    If Dir(DownloadPath) <> "" Then
        Err.Raise 58 'File already exists
    End If

    #If VBA7 = 1 Then
    Dim Result As LongPtr
    #Else
    Dim Result As Long
    #End If

    'Download file
    Result = URLDownloadToFile(0, URL, DownloadPath, 0, 0)

    'Return result of WinAPI function
    WinAPIURLDownloadToFile = Result = &H0

End Function

Public Sub Example()

    Dim FileURL As String
    FileURL = "https://www.vbaplanet.com/downloads/Win32API_PtrSafe.txt"

    Dim DownloadPath As String
    DownloadPath = Environ$("USERPROFILE") & "\Desktop\Example_WinAPI_PtrSafe.txt"

    Dim Result As Boolean
    Result = WinAPIURLDownloadToFile(FileURL, DownloadPath)

    Debug.Print Result

End Sub

Procedure Type

Windows API procedures that do not return a value should be declared in VBA as a Subs. Windows API procedures that do return a value should be declared in VBA as Functions.

Data Types

Data types need to be matched with equivalent types between VBA and C++.

Type	VBA	C++
16-bit signed integer	Boolean	SHORT (True = -1, False = 0)
8-bit unsigned integer	Byte	BYTE
16-bit signed integer	Integer	SHORT
32-bit signed integer	Long	INT or LONG
64-bit signed integer	LongLong	LONGLONG
4-byte single precision floating point	Single	FLOAT
4-byte double precision floating point	Double	DOUBLE
4-byte double precision floating point	Date	DATE (defined as double)
CY data structure	Currency	CY (1 \| 2)
DECIMAL data structure	Decimal	DECIMAL (1 \| 2)
VARIANT data structure	Variant	VARIANT
SAFEARRAY data structure	Array	SAFEARRAY
BSTR data structure	String	BSTR
IDispatch interface	Object	IDispatch

Passing Pointers

VBA provides pointer functions which can be used to retrieve pointers to variables. In VBA7 these functions return a LongPtr and in VBA6 they return a Long.

Pointer Functions:

ObjPtr - Returns a pointer to an object.
StrPtr - Returns a pointer to the string portion of a VBA string variable.
VarPtr - Returns a pointer to a variable.

Passing Arrays

To pass an array to a DLL procedure, pass the first element of the array ByRef.

// C++ 64-bit ExcelFunctions.dll

#define DLLExport __declspec(dllexport)

extern "C" {

    DLLExport int __stdcall CppSum(int nums[], int n) {
        int theSum = 0;
        for (int i = 0; i < n; ++i) {
            theSum += nums[i];
        }
        return theSum;
    }

}

Option Explicit

Declare PtrSafe Function CppSum Lib "C:\ExcelFunctions.dll" ( _
ByRef Nums As Long, ByVal N As Long) As Long

Public Sub Example()

    Dim Arr() As Long
    ReDim Arr(0 To 4)

    Arr(0) = 1
    Arr(1) = 2
    Arr(2) = 3
    Arr(3) = 4
    Arr(4) = 5

    Dim ArrSize As Long
    ArrSize = UBound(Arr) - LBound(Arr) + 1

    Dim Result As Long
    Result = CppSum(Arr(LBound(Arr)), ArrSize)

    Debug.Print Result

End Sub

Passing Functions as Arguments

The AddressOf operator is used to pass the address of a procedure to an API function which requires a function pointer as a parameter.

// C++ 64-bit ExampleDLL.dll

#define DLLExport __declspec(dllexport)

extern "C" {

    DLLExport void __stdcall CppCallProcedure(void (*funcPtr)()) {
        funcPtr();

}

Option Explicit

Public Declare PtrSafe Sub CppCallProcedure Lib "ExcelFunctions.dll" (ByVal Func As LongPtr)

Public Sub Example()
    Call CppCallProcedure(AddressOf HelloWorld)
End Sub

Public Sub HelloWorld()
    MsgBox "Hello, World!"
End Sub

Passing And Returning Structs

It is possible to pass and return structs to and from Windows API procedures by using User-Defined Types in VBA.

Certain structs contain a member representing the size of the struct. The LenB function can be used to find the size in bytes of the user-defined type.

Example: GetOpenFileName

This example declares the GetOpenFileNameA function which utilizes the OPENFILENAMEA data structure.

Option Explicit

Public Sub Example()

    On Error GoTo HandleError

    Dim FileName As String
    FileName = GetOpenFileNameWinAPI()

    Debug.Print FileName

    Exit Sub

HandleError:
    If Err.Number - (vbObjectError + 512) = 2 Then
        MsgBox "No file selected."
    Else
        Err.Raise _
            Number:=Err.Number, _
            Description:=Err.Description
    End If

End Sub

typedef struct tagOFNA {
    DWORD         lStructSize;
    HWND          hwndOwner;
    HINSTANCE     hInstance;
    LPCSTR        lpstrFilter;
    LPSTR         lpstrCustomFilter;
    DWORD         nMaxCustFilter;
    DWORD         nFilterIndex;
    LPSTR         lpstrFile;
    DWORD         nMaxFile;
    LPSTR         lpstrFileTitle;
    DWORD         nMaxFileTitle;
    LPCSTR        lpstrInitialDir;
    LPCSTR        lpstrTitle;
    DWORD         Flags;
    WORD          nFileOffset;
    WORD          nFileExtension;
    LPCSTR        lpstrDefExt;
    LPARAM        lCustData;
    LPOFNHOOKPROC lpfnHook;
    LPCSTR        lpTemplateName;
    LPEDITMENU    lpEditInfo;
    LPCSTR        lpstrPrompt;
    void          *pvReserved;
    DWORD         dwReserved;
    DWORD         FlagsEx;
} OPENFILENAMEA, *LPOPENFILENAMEA;

Option Explicit

#If VBA7 = 1 Then

    Private Type OPENFILENAME
        lStructSize         As Long
        hwndOwner           As LongPtr
        hInstance           As LongPtr
        lpstrFilter         As String
        lpstrCustomFilter   As String
        nMaxCustFilter      As Long
        nFilterIndex        As Long
        lpstrFile           As String
        nMaxFile            As Long
        lpstrFileTitle      As String
        nMaxFileTitle       As Long
        lpstrInitialDir     As String
        lpstrTitle          As String
        flags               As Long
        nFileOffset         As Integer
        nFileExtension      As Integer
        lpstrDefExt         As String
        lCustData           As LongPtr
        lpfnHook            As LongPtr
        lpTemplateName      As String
        '#if (_WIN32_WINNT >= 0x0500)
        pvReserved          As LongPtr
        dwReserved          As Long
        FlagsEx             As Long
        '#endif // (_WIN32_WINNT >= 0x0500)
    End Type

    Private Declare PtrSafe Function GetOpenFileName _
        Lib "comdlg32.dll" _
        Alias "GetOpenFileNameA" ( _
        pOpenfilename As OPENFILENAME) As Long

    Private Declare PtrSafe Function CommDlgExtendedError _
        Lib "comdlg32.dll" () As Long

#Else

    Private Type OPENFILENAME
        lStructSize        As Long
        hwndOwner          As Long
        hInstance          As Long
        lpstrFilter        As String
        lpstrCustomFilter  As String
        nMaxCustFilter     As Long
        nFilterIndex       As Long
        lpstrFile          As String
        nMaxFile           As Long
        lpstrFileTitle     As String
        nMaxFileTitle      As Long
        lpstrInitialDir    As String
        lpstrTitle         As String
        flags              As Long
        nFileOffset        As Integer
        nFileExtension     As Integer
        lpstrDefExt        As String
        lCustData          As Long
        lpfnHook           As Long
        lpTemplateName     As String
    '#if (_WIN32_WINNT >= 0x0500)
        pvReserved         As Long
        dwReserved         As Long
        FlagsEx            As Long
    '#endif // (_WIN32_WINNT >= 0x0500)
    End Type

    Private Declare Function GetOpenFileName _
        Lib "comdlg32.dll" _
        Alias "GetOpenFileNameA" ( _
        pOpenfilename As OPENFILENAME) As Long

    Private Declare Function CommDlgExtendedError _
        Lib "comdlg32.dll" () As Long

#End If

Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000&
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOLONGNAMES = &H40000          '  force no long names for 4.x modules
Private Const OFN_EXPLORER = &H80000             '  new look commdlg
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_LONGNAMES = &H200000           '  force long names for 3.x modules

Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0

Private Const CDERR_DIALOGFAILURE = &HFFFF&

Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_STRUCTSIZE = &H1
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_REGISTERMSGFAIL = &HC

Public Function GetOpenFileNameWinAPI() As String

    Const MAX_BUFFER As Long = 255

    Dim OFN As OPENFILENAME

    With OFN
        '.hwndOwner
        '.hInstance
        .lpstrFilter = "All Files" & vbNullChar & "*.*" & String$(2, vbNullChar)
        '.lpstrCustomFilter
        '.nMaxCustFilter
        .nFilterIndex = 1
        .lpstrFile = String$(MAX_BUFFER - 1, " ") & vbNullChar
        .nMaxFile = Len(.lpstrFile)
        .lpstrFileTitle = String$(MAX_BUFFER - 1, " ") & vbNullChar
        .nMaxFileTitle = Len(.lpstrFileTitle)
        .lpstrInitialDir = "C:\" & vbNullChar
        '.lpstrTitle
        .flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
        '.nFileOffset
        '.nFileExtension
        '.lpstrDefExt
        '.lCustData
        '.lpfnHook
        '.lpTemplateName
        '.pvReserved
        '.dwReserved
        '.FlagsEx
        .lStructSize = LenB(OFN)
    End With

    Dim Result As Long
    Result = GetOpenFileName(OFN)

    If Result <> 0 Then
        GetOpenFileNameWinAPI = Trim$(Replace(OFN.lpstrFile, vbNullChar, " "))
    Else
        Dim CDErr As Long
        CDErr = CommDlgExtendedError()
        Dim UDErr As Long
        Dim ErrMsg As String
        Select Case CDErr
            Case CDERR_DIALOGFAILURE
                UDErr = 1
                ErrMsg = "DIALOG FAILURE"
            Case CDERR_GENERALCODES
                UDErr = 2
                ErrMsg = "GENERAL CODES"
            Case CDERR_STRUCTSIZE
                UDErr = 3
                ErrMsg = "STRUCT SIZE"
            Case CDERR_INITIALIZATION
                UDErr = 4
                ErrMsg = "INITIALIZATION"
            Case CDERR_NOTEMPLATE
                UDErr = 5
                ErrMsg = "NO TEMPLATE"
            Case CDERR_NOHINSTANCE
                UDErr = 6
                ErrMsg = "NO HINSTANCE"
            Case CDERR_LOADSTRFAILURE
                UDErr = 7
                ErrMsg = "LOAD STR FAILURE"
            Case CDERR_FINDRESFAILURE
                UDErr = 8
                ErrMsg = "FIND RES FAILURE"
            Case CDERR_LOADRESFAILURE
                UDErr = 9
                ErrMsg = "LOAD RES FAILURE"
            Case CDERR_LOCKRESFAILURE
                UDErr = 10
                ErrMsg = "LOCK RES FAILURE"
            Case CDERR_MEMALLOCFAILURE
                UDErr = 11
                ErrMsg = "MEM ALLOC FAILURE"
            Case CDERR_MEMLOCKFAILURE
                UDErr = 12
                ErrMsg = "MEM LOCK FAILURE"
            Case CDERR_NOHOOK
                UDErr = 13
                ErrMsg = "NO HOOK"
            Case CDERR_REGISTERMSGFAIL
                UDErr = 14
                ErrMsg = "REGISTER MSG FAIL"
            Case Else
                UDErr = 15
                ErrMsg = "Unknown Error"
        End Select
        Err.Raise _
            Number:=vbObjectError + 512 + UDErr, _
            Description:=ErrMsg
    End If

End Function

Example: ChooseColor

This example declares the ChooseColor function which utilizes the CHOOSECOLOR struct.

Option Explicit

Public Sub Example()

    On Error GoTo HandleError

    Dim C As Long
    C = ChooseColorWinAPI()

    Debug.Print C
    Range("A1").Interior.Color = C

    Exit Sub

HandleError:
    If Err.Number - (vbObjectError + 512) = 2 Then
        MsgBox "No color selected."
    Else
        Err.Raise _
            Number:=Err.Number, _
            Description:=Err.Description
    End If

End Sub

typedef struct tagCHOOSECOLORA {
    DWORD        lStructSize;
    HWND         hwndOwner;
    HWND         hInstance;
    COLORREF     rgbResult;
    COLORREF     *lpCustColors;
    DWORD        Flags;
    LPARAM       lCustData;
    LPCCHOOKPROC lpfnHook;
    LPCSTR       lpTemplateName;
    LPEDITMENU   lpEditInfo;
} CHOOSECOLORA, *LPCHOOSECOLORA;

Option Explicit

#If VBA7 = 1 Then

    Private Type ChooseColor
        lStructSize     As Long
        hwndOwner       As LongPtr
        hInstance       As LongPtr
        rgbResult       As Long
        lpCustColors    As LongPtr
        flags           As Long
        lCustData       As LongPtr
        lpfnHook        As LongPtr
        lpTemplateName  As String
    End Type

    Private Declare PtrSafe Function ChooseColor _
        Lib "comdlg32.dll" _
        Alias "ChooseColorA" ( _
        pChoosecolor As ChooseColor) As Long

    Private Declare PtrSafe Function CommDlgExtendedError _
        Lib "comdlg32.dll" () As Long
   
#Else

    Private Type ChooseColor
        lStructSize     As Long
        hwndOwner       As Long
        hInstance       As Long
        rgbResult       As Long
        lpCustColors    As Long
        flags           As Long
        lCustData       As Long
        lpfnHook        As Long
        lpTemplateName  As String
    End Type

    Private Declare Function ChooseColor _
        Lib "comdlg32.dll" _
        Alias "ChooseColorA" ( _
        pChoosecolor As ChooseColor) As Long

    Private Declare Function CommDlgExtendedError _
        Lib "comdlg32.dll" () As Long

#End If

Private Const CC_RGBINIT = &H1
Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_SHOWHELP = &H8
Private Const CC_ENABLEHOOK = &H10
Private Const CC_ENABLETEMPLATE = &H20
Private Const CC_ENABLETEMPLATEHANDLE = &H40
Private Const CC_SOLIDCOLOR = &H80
Private Const CC_ANYCOLOR = &H100

Private Const CDERR_DIALOGFAILURE = &HFFFF&

Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_STRUCTSIZE = &H1
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_REGISTERMSGFAIL = &HC

Public Function ChooseColorWinAPI() As Long

    Dim CC As ChooseColor
    Dim CustomColors(16) As Long

    CustomColors(0) = RGB(0, 140, 140)

    With CC
        .hwndOwner = Application.Windows(1).Hwnd
        '.hInstance
        '.rgbResult
        .lpCustColors = VarPtr(CustomColors(0))
        .flags = CC_ANYCOLOR Or CC_FULLOPEN Or CC_PREVENTFULLOPEN Or CC_RGBINIT
        '.lCustData
        '.lpfnHook
        '.lpTemplateName
        .lStructSize = LenB(CC)
    End With

    Dim Result As Long
    Result = ChooseColor(CC)

    If Result <> 0 Then
        ChooseColorWinAPI = CC.rgbResult
        
    Else
        ChooseColorWinAPI = RGB(0, 0, 0)
        Dim CDErr As Long
        CDErr = CommDlgExtendedError()
        Dim UDErr As Long
        Dim ErrMsg As String
        Select Case CDErr
            Case CDERR_DIALOGFAILURE
                UDErr = 1
                ErrMsg = "DIALOG FAILURE"
            Case CDERR_GENERALCODES
                UDErr = 2
                ErrMsg = "GENERAL CODES"
            Case CDERR_STRUCTSIZE
                UDErr = 3
                ErrMsg = "STRUCT SIZE"
            Case CDERR_INITIALIZATION
                UDErr = 4
                ErrMsg = "INITIALIZATION"
            Case CDERR_NOTEMPLATE
                UDErr = 5
                ErrMsg = "NO TEMPLATE"
            Case CDERR_NOHINSTANCE
                UDErr = 6
                ErrMsg = "NO HINSTANCE"
            Case CDERR_LOADSTRFAILURE
                UDErr = 7
                ErrMsg = "LOAD STR FAILURE"
            Case CDERR_FINDRESFAILURE
                UDErr = 8
                ErrMsg = "FIND RES FAILURE"
            Case CDERR_LOADRESFAILURE
                UDErr = 9
                ErrMsg = "LOAD RES FAILURE"
            Case CDERR_LOCKRESFAILURE
                UDErr = 10
                ErrMsg = "LOCK RES FAILURE"
            Case CDERR_MEMALLOCFAILURE
                UDErr = 11
                ErrMsg = "MEM ALLOC FAILURE"
            Case CDERR_MEMLOCKFAILURE
                UDErr = 12
                ErrMsg = "MEM LOCK FAILURE"
            Case CDERR_NOHOOK
                UDErr = 13
                ErrMsg = "NO HOOK"
            Case CDERR_REGISTERMSGFAIL
                UDErr = 14
                ErrMsg = "REGISTER MSG FAIL"
            Case Else
                UDErr = 15
                ErrMsg = "Unknown Error"
        End Select
        Err.Raise _
            Number:=vbObjectError + 512 + UDErr, _
            Description:=ErrMsg
    End If

End Function