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

Declaring an External Function to the Compiler

   <source lang="vb">

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

</source>
   
  

Playing .Wav files via the Windows API

   <source lang="vb">

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

</source>
   
  

Use 32-bit API declaration

   <source lang="vb">

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

</source>
   
  

Using a Function in a DLL

   <source lang="vb">

   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
</source>
   
  

Waiting for an application to end

   <source lang="vb">

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

</source>