VBA/Excel/Access/Word/Windows API/Windows API

Declaring an External Function to the Compiler

 
Declare Function abGetSystemDirectory _
   Lib "kernel32" _
   Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) _
   As Long
Sub WinSysDir()
   Dim strBuffer As String
   Dim intLength As Integer
   Dim strDirectory As String
   strBuffer = Space$(160)
   intLength = abGetSystemDirectory(strBuffer, Len(strBuffer))
   strDirectory = Left(strBuffer, intLength)
   MsgBox strDirectory
End Sub

Playing .Wav files via the Windows API

 
Public Declare Function sndPlaySoundA Lib "winmm.dll" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Sub PlayWav(WavFile As String)
    If Application.CanPlaySounds = False Then
        MsgBox "Sorry, sound is not supported on your system."
        Exit Sub
    End If
    If Dir(WavFile) = "" Then
        MsgBox ("Wave file not found")
        Exit Sub
    End If
    sndPlaySoundA WavFile, 1
End Sub
Public Sub TestPlayWav1()
    Dim filePath As String
    filePath = ActiveWorkbook.Path
    PlayWav (filePath & "\Sounds\cannon.wav")
End Sub

Use 32-bit API declaration

 
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Sub DisplayVideoInfo()
    vidWidth = GetSystemMetrics(SM_CXSCREEN)
    vidHeight = GetSystemMetrics(SM_CYSCREEN)
    
    Debug.Print vidWidth & " X " & vidHeight
End Sub

Using a Function in a DLL

 
    Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Public Const SM_SWAPBUTTON = 23
    Sub ShowHands()
       If GetSystemMetrics(SM_SWAPBUTTON) = False Then
           MsgBox "Your mouse is right-handed!"
       Else
           MsgBox "Your mouse is left-handed!"
        End If
    End Sub

Waiting for an application to end

 
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Sub RunCharMap2()
    Dim TaskID As Long
    Dim hProc As Long
    Dim lExitCode As Long
    ACCESS_TYPE = &H400
    STILL_ACTIVE = &H103
    Program = "Charmap.exe"
    TaskID = Shell(Program, 1)
    hProc = OpenProcess(ACCESS_TYPE, False, TaskID)
    If Err <> 0 Then
        Debug.Print "Cannot start " & Program, vbCritical, "Error"
        Exit Sub
    End If
    Do
        GetExitCodeProcess hProc, lExitCode
        DoEvents
    Loop While lExitCode = STILL_ACTIVE
End Sub