[AccessD] Office API's

On 9 Dec 2010 at 20:10, Susan Harkins wrote:

> Windows API functions. 
> Susan H. 
> 
> > Susan - did you mean to say "add-ins" ?
> > I'm not sure what you are referring to....
> >>
> >> I'm writing about Office APIs -- if you have a favorite one
> >> you'd like to see showcased, let me know.
> 


Ah Windows APIs.   I use quite a few of them.    Here's a few API calls and functions that I 
use in most systems that I build (I keep them along with a number of other functions in a 
module of general functions that I just plug in to new apps by default,  Listing from the 
simplest to the most complex:

1  Sleep (suspend execute for a while a.k.a  Wait()

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


2.  Get User - Get the name of the current user for logging purposes/access control

    Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
                 "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function GetUser()
    Dim Response As Long
    Dim uname As String * 32
    Response = GetUserName(uname, 32)
    GetUser = Left(uname, InStr(uname, Chr$(0)) - 1)
End Function


3.  Temp Directory  (If you need to build and run a batch file or a set of FTP commands etc)

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
                        (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Function TempDir() As String
    Dim strPath As String
    strPath = Space(MAX_PATH)
    GetTempPath Len(strPath), strPath
    TempDir = Left(strPath, InStr(1, strPath, vbNullChar) - 1)
End Function


4.   Desktop Directory ( so that I can drop files onto it or look for files on it)

Private Declare Function SHGetSpecialFolderLocation _
                          Lib "shell32" (ByVal hwnd As Long, _
                                         ByVal nFolder As Long, ppidl As Long) As Long
Private Declare Function SHGetPathFromIDList _
                          Lib "shell32" Alias "SHGetPathFromIDListA" _
                              (ByVal Pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
Public Function Desktop() As String
    Dim lngPidlFound As Long
    Dim lngFolderFound As Long
    Dim lngPidl As Long
    Dim strPath As String
    Const CSIDL_DESKTOPDIRECTORY = &H10
    Const MAX_PATH = 260
    Const NOERROR = 0

    strPath = Space(MAX_PATH)
    lngPidlFound = SHGetSpecialFolderLocation(0, CSIDL_DESKTOPDIRECTORY, lngPidl)
    If lngPidlFound = NOERROR Then
        lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
        If lngFolderFound Then
            Desktop = Left$(strPath, _
                            InStr(1, strPath, vbNullChar) - 1) & "\"
        End If
    End If
    CoTaskMemFree lngPidl
End Function


5.  GetOpenFileName - no need to embed a control on a form to get an openfile dialog.

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

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
End Type

Function GetFileName(Directory As String) As String
    Dim OpenFile As OPENFILENAME
    Dim lReturn As Long
    Dim sFilter As String
    OpenFile.lStructSize = Len(OpenFile)
    OpenFile.hwndOwner = 0
    OpenFile.hInstance = 0
    sFilter = "" & Chr(0)
    OpenFile.lpstrFilter = sFilter
    OpenFile.nFilterIndex = 0
    OpenFile.lpstrFile = String(257, 0)
    OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = Directory
    OpenFile.lpstrTitle = "Select File"
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)
    GetFileName = Left$(OpenFile.lpstrFile, InStr(OpenFile.lpstrFile, Chr$(0)) - 1)
End Function



6. ShellWait - Shell out to an application and wait for it to finish before continuing 
(synchronous shell)

    Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
                                  ByVal dwMilliseconds As Long) As Long
    Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, _
                  ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, _
                  ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, _
                  ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, _
                  ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, _
                  lpProcessInformation As PROCESS_INFORMATION) As Long
    Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const STARTF_USESHOWWINDOW& = &H1
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long)
    On Error GoTo Err_Handler

    Dim proc As PROCESS_INFORMATION
    Dim start As STARTUPINFO
    Dim ret As Long

    ' Initialize the STARTUPINFO structure:
    With start
        .cb = Len(start)
        If Not IsMissing(WindowStyle) Then
            .dwFlags = STARTF_USESHOWWINDOW
            .wShowWindow = WindowStyle
        End If
    End With
    ' Start the shelled application:
    ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, 
start, proc)
    ' Wait for the shelled application to finish:
    ret& = WaitForSingleObject(proc.hProcess, INFINITE)
    ret& = CloseHandle(proc.hProcess)

Exit_Here:
    Exit Sub
Err_Handler:
    MsgBox Err.Description, vbExclamation, "E R R O R"
    Resume Exit_Here

End Sub



-- 
Stuart