With all the wonderful things you can do in Excel VBA, there are some things that are out of its reach or just difficult to do—such as finding out what the user’s screen resolution setting is. This is where the Windows application programming interface, or API, can help.
If you look in the folder WinntSystem32 (Windows NT systems), you’ll see a lot of files with the extension .dll. These files are dynamic link libraries; they contain various functions and procedures that other programs, including VBA, can access. They give the user access to functionality used by the Windows operating system and many other programs. Keep in mind that Windows API declarations are accessible only on computers running the Microsoft Windows operating system.
This chapter doesn’t teach you how to write API declarations, but it does teach you the basics of interpreting and using them. Several useful examples have also been included and you will be shown how to find more.
The following line is an example of an API function:
Private Declare Function GetUserName _ Lib "advapi32.dll" Alias "GetUserNameA" _ (ByVal lpBuffer As String, nSize As Long) _ As Long
There are two types of API declarations: functions, which return information, and procedures, which do something to the system. The declarations are structured similarly.
Basically, what this declaration is saying is
It’s
Private, meaning it can only be used in the module in which it is declared. Declare itPublicin a standard module if you want to share it among several modules.It will be referred to as
GetUserNamein your program. This is the variable name assigned by you.The function being used is found in advapi32.dll.
The alias,
GetUserNameA, is what the function is referred to in the DLL. This name is case sensitive and cannot be changed; it is specific to the DLL. There are often two versions of each API function. One version uses the ANSI character set and has aliases that end with the letter A. The other version uses the Unicode character set and has aliases that end with the letter W. When specifying the alias, you are telling VBA which version of the function to use.There are two parameters:
lpBufferandnSize. These are two arguments that the DLL function accepts.
The downside of using APIs is that there may be no errors when your code compiles or runs, and then an incorrectly configured API call can cause your computer to crash or lock up. So, it’s a good idea to save often.
Using an API is no different from calling a function or procedure you created in VBA. The following example uses the GetUserName declaration in a function to return the UserName in Excel:
Public Function UserName() As String
Dim sName As String * 256
Dim cChars As Long
cChars = 256
If GetUserName(sName, cChars) Then
UserName = Left$(sName, cChars - 1)
End If
End Function
Sub ProgramRights()
Dim NameofUser As String
NameofUser = UserName
Select Case NameofUser
Case Is = "Administrator"
MsgBox "You have full rights to this computer"
Case Else
MsgBox "You have limited rights to this computer"
End Select
End SubRun the ProgramRights macro and you will learn whether you are currently signed on as the administrator. The result shown in Figure 24.1 indicates an administrator sign-on.
The following sections provide more examples of useful API declarations you can use in your Excel programs. Each example starts with a short description of what the example can do, followed by the actual declaration(s), and an example of its use.
This API function returns the computer name. This is the name of the computer found under MyComputer, Network Identification:
Private Declare Function GetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, ByRef nSize As Long) As Long
Private Function ComputerName() As String
Dim stBuff As String * 255, lAPIResult As Long
Dim lBuffLen As Long
lBuffLen = 255
lAPIResult = GetComputerName(stBuff, lBuffLen)
If lBuffLen > 0 Then ComputerName = Left(stBuff, lBuffLen)
End Function
Sub ComputerCheck()
Dim CompName As String
CompName = ComputerName
If CompName <> "BillJelenPC" Then
MsgBox _
"This application does not have the right to run on this computer."
ActiveWorkbook.Close SaveChanges:=False
End If
End SubThe ComputerCheck macro uses an API call to get the name of the computer. In Figure 24.2, the program refuses to run for any computer except the hard-coded computer name of the owner.
You can check whether you have a file open in Excel by trying to set the workbook to an object. If the object is Nothing (empty), you know the file isn’t opened. But what if you want to see whether someone else on a network has the file open? The following API function returns that information:
Private Declare Function lOpen Lib "kernel32" Alias "_lopen" _
(ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
Private Declare Function lClose Lib "kernel32" _
Alias "_lclose" (ByVal hFile As Long) As Long
Private Const OF_SHARE_EXCLUSIVE = &H10
Private Function FileIsOpen(strFullPath_FileName As String) As Boolean
Dim hdlFile As Long
Dim lastErr As Long
hdlFile = -1
hdlFile = lOpen(strFullPath_FileName, OF_SHARE_EXCLUSIVE)
If hdlFile = -1 Then
lastErr = Err.LastDllError
Else
lClose (hdlFile)
End If
FileIsOpen = (hdlFile = -1) And (lastErr = 32)
End Function
Sub CheckFileOpen()
If FileIsOpen("C:XYZ Corp.xlsx") Then
MsgBox "File is open"
Else
MsgBox "File is not open"
End If
End SubCalling the FileIsOpen function with a particular path and filename as the parameter will tell you whether someone has the file open.
The following API function retrieves the computer’s display size:
Declare Function DisplaySize Lib "user32" Alias _
"GetSystemMetrics" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Function VideoRes() As String
Dim vidWidth
Dim vidHeight
vidWidth = DisplaySize(SM_CXSCREEN)
vidHeight = DisplaySize(SM_CYSCREEN)
Select Case (vidWidth * vidHeight)
Case 307200
VideoRes = "640 x 480"
Case 480000
VideoRes = "800 x 600"
Case 786432
VideoRes = "1024 x 768"
Case Else
VideoRes = "Something else"
End Select
End Function
Sub CheckDisplayRes()
Dim VideoInfo As String
Dim Msg1 As String, Msg2 As String, Msg3 As String
VideoInfo = VideoRes
Msg1 = "Current resolution is set at " & VideoInfo & Chr(10)
Msg2 = "Optimal resolution for this application is 1024 x 768" & Chr(10)
Msg3 = "Please adjust resolution"
Select Case VideoInfo
Case Is = "640 x 480"
MsgBox Msg1 & Msg2 & Msg3
Case Is = "800 x 600"
MsgBox Msg1 & Msg2
Case Is = "1024 x 768"
MsgBox Msg1
Case Else
MsgBox Msg2 & Msg3
End Select
End SubThe CheckDisplayRes macro warns the client that the display setting is not optimal for the application.
If you go to Help, About Windows in Windows Explorer, you get a nice little About dialog with information about the Windows Explorer and a few system details. With the following code, you can pop up that window in your own program and customize a few items, as shown in Figure 24.3.
Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" _
(ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, _
ByVal hIcon As Long) As Long
Declare Function GetActiveWindow Lib "user32" () As Long
Sub AboutMrExcel()
Dim hwnd As Integer
On Error Resume Next
hwnd = GetActiveWindow()
ShellAbout hwnd, Nm, vbCrLf + Chr(169) + "" & " MrExcel.com Consulting" _
+ vbCrLf, 0
On Error GoTo 0
End SubIn the upper-right corner of a userform, there is an X button that can be used to shut down the application. The following API declarations work together to disable that X, forcing the user to use the Close button. When the form is initialized, the button is disabled. After the form is closed, the X button is reset to normal:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Long) As Long
Private Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Private Const SC_CLOSE As Long = &HF060
Private Sub UserForm_Initialize()
Dim hWndForm As Long
Dim hMenu As Long
hWndForm = FindWindow("ThunderDFrame", Me.Caption) 'XL2000
hMenu = GetSystemMenu(hWndForm, 0)
DeleteMenu hMenu, SC_CLOSE, 0&
End SubThe DeleteMenu macro in the UserForm_Initialize procedure causes the X in the corner of the userform to be grayed out, as shown in Figure 24.4. This forces the client to use your programmed Close button.
You can use the NOW function to get the time, but what if you needed a running timer? A timer displaying the exact time as the seconds tick by? The following API declarations work together to provide that functionality. The timer is placed in cell A1 of Sheet1:
Public Declare Function SetTimer Lib "user32" _
(ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" _
(ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private lngTimerID As Long
Public datStartingTime As Date
Public Sub StartTimer()
lngTimerID = SetTimer(0, 1, 10, AddressOf RunTimer)
End Sub
Public Sub StopTimer()
Dim lRet As Long
lRet = KillTimer(0, lngTimerID)
End Sub
Private Sub RunTimer(ByVal hWnd As Long, _
ByVal uint1 As Long, ByVal nEventId As Long, _
ByVal dwParam As Long)
On Error Resume Next
Sheet1.Range("A1").Value = Now - datStartingTime
End SubRun the StartTimer macro to have the current date and time constantly updated in cell A1.
Ever wanted to play a sound to warn users or congratulate them? You could add a sound object to a sheet and call that, but it would be much easier just to use the following API declaration and specify the proper path to a sound file:
Public Declare Function PlayWavSound Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal LpszSoundName As String, _
ByVal uFlags As Long) As Long
Public Sub PlaySound()
Dim SoundName As String
SoundName = "C:WinNTMediaChimes.wav"
PlayWavSound SoundName, 0
End SubThe following API enables you to create a custom file browser. The program example using the API customizes the function call to create a browser for a specific need—in this case, returning the file path of a user-selected file:
Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000
Function ahtCommonFileOpenSave( _
Optional ByRef Flags As Variant, _
Optional ByVal InitialDir As Variant, _
Optional ByVal Filter As Variant, _
Optional ByVal FilterIndex As Variant, _
Optional ByVal DefaultExt As Variant, _
Optional ByVal FileName As Variant, _
Optional ByVal DialogTitle As Variant, _
Optional ByVal hwnd As Variant, _
Optional ByVal OpenFile As Variant) As Variant
' This is the entry point you'll use to call the common
' file Open/Save As dialog. The parameters are listed
' below, and all are optional.
'
' In:
' Flags: one or more of the ahtOFN_* constants, OR'd together.
' InitialDir: the directory in which to first look
' Filter: a set of file filters
' (Use AddFilterItem to set up Filters)
' FilterIndex: 1-based integer indicating which filter
' set to use, by default (1 if unspecified)
' DefaultExt: Extension to use if the user doesn't enter one.
' Only useful on file saves.
' FileName: Default value for the filename text box.
' DialogTitle: Title for the dialog.
' hWnd: parent window handle
' OpenFile: Boolean(True=Open File/False=Save As)
' Out:
' Return Value: Either Null or the selected filename
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
' Give the dialog a caption title.
If IsMissing(InitialDir) Then InitialDir = CurDir
If IsMissing(Filter) Then Filter = ""
If IsMissing(FilterIndex) Then FilterIndex = 1
If IsMissing(Flags) Then Flags = 0&
If IsMissing(DefaultExt) Then DefaultExt = ""
If IsMissing(FileName) Then FileName = ""
If IsMissing(DialogTitle) Then DialogTitle = ""
If IsMissing(OpenFile) Then OpenFile = True
' Allocate string space for the returned strings.
strFileName = Left(FileName & String(256, 0), 256)
strFileTitle = String(256, 0)
' Set up the data structure before you call the function
With OFN
.lStructSize = Len(OFN)
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFileName
.nMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.Flags = Flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
.hInstance = 0
.lpfnHook = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
' This passes the desired data structure to the
' Windows API, which will in turn display
' the Open/Save As dialog.
If OpenFile Then
fResult = aht_apiGetOpenFileName(OFN)
Else
fResult = aht_apiGetSaveFileName(OFN)
End If
' The function call filled in the strFileTitle member
' of the structure. You have to write special code
' to retrieve that if you're interested.
If fResult Then
' You might care to check the Flags member of the
' structure to get information about the chosen file.
' In this example, if you bothered to pass a
' value for Flags, we'll fill it in with the outgoing
' Flags value.
If Not IsMissing(Flags) Then Flags = OFN.Flags
ahtCommonFileOpenSave = TrimNull(OFN.strFile)
Else
ahtCommonFileOpenSave = vbNullString
End If
End Function
Function ahtAddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String
' Tack a new chunk onto the file filter.
' That is, take the old value, stick onto it the description,
' (like "Databases"), a null character, the skeleton
' (like "*.mdb;*.mda"), and a final null character.
If IsMissing(varItem) Then varItem = "*.*"
ahtAddFilterItem = strFilter & strDescription & _
vbNullChar & varItem & vbNullChar
End Function
Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End FunctionThis is the actual program created to use this information:
Function GetFileName(strPath As String)
Dim strFilter As String
Dim lngFlags As Long
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)")
GetFileName = ahtCommonFileOpenSave(InitialDir:=strPath, _
Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
DialogTitle:="Please select file to import")
End FunctionThen create the userform. The following code is attached to the Browse button, as shown in Figure 24.5. Note that the function specifies the starting directory:
Private Sub cmdBrowse_Click()
txtFile = GetFileName("c:")
End Sub
There are many more API declarations out there than the ones we have shown—we’ve barely scratched the surface of the wealth of procedures and functions available. Microsoft has many tools available to help you create your own APIs (search Platform SDK), but there are also many programmers who have developed declarations to share, such as Ivan F. Moala at http://xcelfiles.homestead.com/APIIndex.html. He has created a site full of not only examples, but instruction, too.
In Chapter 25, “Handling Errors,” you will learn about error handling. In a perfect world, you want to be able to hand your applications off to a co-worker, leave for vacation, and not have to worry about an unhandled error appearing while you are on the beach. Chapter 25 discusses how to handle obvious and not-so-obvious errors.