' Uncomment (Remove the ' ) the two lines of code below if they are not already at the top of your Module
'Option Compare Database
'Option Explicit
 
 
'---------------------------------------------------------------------------------------
' Procedure : AddReferenceMSODLL
' DateTime  : 7/31/2008 03:24
' Author    : Patrick Wood  http://gainingaccess.net
' Purpose   : Set Required reference to Microsoft Office Object Library with code
' Usage     : You are welcome to use and modify this code
'           : if you leave this header intact.
'---------------------------------------------------------------------------------------
'
Sub AddReferenceMSODLL()
On Error GoTo Err_AddReferenceMSODLL
 
    Dim refItem As Reference
    Dim strFile As String
    ' Use to get the number of References
    ' When the number increases by one the reference has been set
    Dim intRefCount As Integer
    Dim intCount As Integer ' Use to count the number of Errors
    intCount = 0
    intRefCount = Access.References.Count
 
    ' Check the places where the Library File is usually located
    strFile = "C:\Program Files\Common Files\Microsoft Shared\Office10\MSO.DLL"
    Set refItem = Access.References.AddFromFile(strFile)
    If Access.References.Count = intRefCount + 1 Then
        Debug.Print "Reference Set = " & strFile
        Exit Sub
    End If
 
    strFile = "C:\Program Files\Common Files\Microsoft Shared\Office11\MSO.DLL"
    Set refItem = Access.References.AddFromFile(strFile)
    If Access.References.Count = intRefCount + 1 Then
        Debug.Print "Reference Set = " & strFile
        Exit Sub
    End If
 
    strFile = "C:\Program Files\Common Files\Microsoft Shared\Office12\MSO.DLL"
    Set refItem = Access.References.AddFromFile(strFile)
    If Access.References.Count = intRefCount + 1 Then
        Debug.Print "Reference Set = " & strFile
        Exit Sub
    End If
 
    strFile = "D:\Program Files\Common Files\Microsoft Shared\Office10\MSO.DLL"
    Set refItem = Access.References.AddFromFile(strFile)
    If Access.References.Count = intRefCount + 1 Then
        Debug.Print "Reference Set = " & strFile
        Exit Sub
    End If
 
    strFile = "D:\Program Files\Common Files\Microsoft Shared\Office11\MSO.DLL"
    Set refItem = Access.References.AddFromFile(strFile)
    If Access.References.Count = intRefCount + 1 Then
        Debug.Print "Reference Set = " & strFile
        Exit Sub
    End If
 
    strFile = "D:\Program Files\Common Files\Microsoft Shared\Office12\MSO.DLL"
    Set refItem = Access.References.AddFromFile(strFile)
    If Access.References.Count = intRefCount + 1 Then
        Debug.Print "Reference Set = " & strFile
        Exit Sub
    End If
 
    ' If we got here, the reference was not found
    Call MsgBox("A Reference must be set to the Microsoft Office Object Library")
 
Exit_AddReferenceMSODLL:
    Exit Sub
 
Err_AddReferenceMSODLL:
    If Err.Number = 29060 Then
        intCount = intCount + 1
        Debug.Print "File Not Found " & intCount
        Resume Next
    ElseIf Err.Number = 53 Then
        intCount = intCount + 1
        Debug.Print "File Not Found " & intCount
        Resume Next
    ElseIf Err.Number = 32813 Then
        Debug.Print "Reference already exists."
        Resume Exit_AddReferenceMSODLL
    Else
        Call MsgBox(Err.Description & vbCrLf & "Error Number= " & Err.Number & vbCrLf & _
        " In procedure AddReferenceMSODLL of Module basCommonDialog")
        Resume Exit_AddReferenceMSODLL
    End If
End Sub
 
 
'---------------------------------------------------------------------------------------
' Procedure : GetFolderPath
' DateTime  : 7/31/2008 03:27
' Author    : Microsoft? Modified by Patrick Wood
' Purpose   : Gets a Folder Path String
' Arguments :
'---------------------------------------------------------------------------------------
'
Function GetFolderPath() As String
' Requires a reference to Microsoft Office Object Library
On Error GoTo Err_GetFolderPath
 
    'Declare a variable as a FileDialog object.
    Dim fldrpkr As FileDialog
 
    'Create a FileDialog object as a Folder Picker dialog box.
    Set fldrpkr = Application.FileDialog(msoFileDialogFolderPicker)
 
    'Declare a variable to contain the path
    'of each selected item. Even though the path is a String,
    'the variable must be a Variant because For Each...Next
    'routines only work with Variants and Objects.
    Dim vrtSelectedItem As Variant
 
    'Use a With...End With block to reference the FileDialog object.
    With fldrpkr
 
        'Use the Show method to display the File Picker dialog box
        'The user pressed the action button.
        If .Show = -1 Then
 
            'Step through the FileDialogSelectedItems collection.
            For Each vrtSelectedItem In .SelectedItems
 
                'vrtSelectedItem contains the path of each selected item.
                'Here use any file I/O functions you want on the path.
 
            ' Added by Patrick Wood - only need one Folder Path
            GetFolderPath = vrtSelectedItem
'            Debug.Print GetFolderPath
 
            Next vrtSelectedItem
        'The user pressed Cancel.
        Else
        End If
    End With
 
    'Set the object variable to Nothing.
    Set fldrpkr = Nothing
 
 
Exit_GetFolderPath:
    Exit Function
 
Err_GetFolderPath:
    Call MsgBox(Err.Description & vbCrLf & "Error Number: " & Err.Number & vbCrLf & _
    " In procedure GetFolderPath of Module basFolderDialog")
    Resume Exit_GetFolderPath
 
End Function