Help with Excel code to connect to Access password database

[dj_mix]

can anyone help ass code this this module so it will connect to a access database file that has a password. The code works fine on non password database file. I search the web and found some info but doesn't seem to work for me..

main module

Option Explicit

'Look in the Examples module how you can call this macro

Public Sub GetDataFromAccess(MyDatabaseFilePathAndName As String, MyTable As String, _
                             MyTableField1 As String, S1 As String, MyFieldValue1 As String, _
                             MyTableField2 As String, S2 As String, MyFieldValue2 As String, _
                             MyTableField3 As String, S3 As String, MyFieldValue3 As String, _
                             MyTableField4 As String, S4 As String, MyFieldValue4 As String, _
                             MyTableField5 As String, S5 As String, MyFieldValue5 As String, _
                             MyTableField6 As String, S6 As String, MyFieldValue6 As String, _
                             MyTableField7 As String, S7 As String, MyFieldValue7 As String, _
                             DestSheetRange As Range, WhichFields As String, _
                             FieldNames As Boolean, ClearRange As Boolean)

'Date changed : 18 Feb 2006
'Add the WhichFields option to copy only the fields you want

    Dim MyConnection As String
    Dim MySQL As String
    Dim MyDatabase As Object
    Dim col As Integer
    Dim I As Integer
    Dim str1 As Variant
    Dim str2 As Variant
    Dim str3 As Variant

    'Select the DestSheetRange where you paste the records
    Application.GoTo DestSheetRange

    'If ClearRange = True it clear all cells on that sheet first
    If ClearRange Then Range(DestSheetRange.Address, "IV" & Rows.Count).ClearContents

    'Create connection string
    MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;"
    MyConnection = MyConnection & "Data Source=" & MyDatabaseFilePathAndName & ";"
    ' Create MySQL string
    str1 = Array(MyTableField1, MyTableField2, MyTableField3, MyTableField4, MyTableField5, MyTableField6, MyTableField7)
    str2 = Array(S1, S2, S3, S4, S5, S6, S7)
    str3 = Array(MyFieldValue1, MyFieldValue2, MyFieldValue3, MyFieldValue4, MyFieldValue5, MyFieldValue6, MyFieldValue7)


    MySQL = ""
    For I = LBound(str1) To UBound(str1)
        If str3(I) <> "" Then
            If MySQL = "" Then
                If I <= 2 Then
                    MySQL = "SELECT " & WhichFields & " FROM " & MyTable & " WHERE [" _
                            & str1(I) & "] " & str2(I) & " '" & str3(I) & "'"
                ElseIf I = 3 Or I = 4 Then
                    MySQL = "SELECT " & WhichFields & " FROM " & MyTable & " WHERE [" _
                            & str1(I) & "] " & str2(I) & " " & str3(I)

                ElseIf I = 5 Or I = 6 Then
                    MySQL = "SELECT " & WhichFields & " FROM " & MyTable & " WHERE [" _
                            & str1(I) & "] " & str2(I) & " #" & str3(I) & "#"
                End If

            Else
                If I <= 2 Then
                    MySQL = MySQL & " and [" & str1(I) & "] " & str2(I) & " '" & str3(I) & "'"
                ElseIf I = 3 Or I = 4 Then
                    MySQL = MySQL & " and [" & str1(I) & "] " & str2(I) & " " & str3(I)
                ElseIf I = 5 Or I = 6 Then
                    MySQL = MySQL & " and [" & str1(I) & "] " & str2(I) & " #" & str3(I) & "#"
                End If
            End If
        End If
    Next I

    'If MySQL is empty copy all records
    If MySQL = "" Then MySQL = "SELECT " & WhichFields & " FROM " & MyTable & ";"


    ' Open the database and copy the data
    On Error GoTo SomethingWrong
    Set MyDatabase = CreateObject("adodb.recordset")
    MyDatabase.Open MySQL, MyConnection, 0, 1, 1

    ' Check to make sure we received data and copy the data
    If Not MyDatabase.EOF Then

        'If FieldNames = True copy the field names and records
        'If = False copy only records
        If FieldNames Then
            For col = 0 To MyDatabase.Fields.Count - 1
                DestSheetRange.Offset(0, col).Value = MyDatabase.Fields(col).Name
            Next
            DestSheetRange.Offset(1, 0).CopyFromRecordset MyDatabase
        Else
            DestSheetRange.CopyFromRecordset MyDatabase
        End If
    Else
        MsgBox "No records returned from : " & MyDatabaseFilePathAndName, vbCritical
    End If

    MyDatabase.Close
    Set MyDatabase = Nothing
    Exit Sub

SomethingWrong:
    On Error GoTo 0
    Set MyDatabase = Nothing
    MsgBox "Error copying data", vbCritical, "Test Access data to Excel"

End Sub

second module

Sub access()
'This example retrieves the data for the records in which ShipCountry = Germany
    ActiveSheet.Unprotect
        GetDataFromAccess ThisWorkbook.Path & "/MA.mdb", "allotment", _
                      "", "=", "", _
                      "", "=", "", _
                      "", "=", "", _
                      "roadid", "=", Sheets("Menu").Range("S2").Value, _
                      "", "<", "", _
                      "", ">=", "", _
                      "", "<=", "", _
                      Sheets("Menu").Range("AN2"), _
                      "*", False, True
End Sub
Sub access2()
'This example retrieves the data for the records in which ShipCountry = Germany
    GetDataFromAccess ThisWorkbook.Path & "/MA.mdb", "agreements", _
                      "", "=", "", _
                      "", "=", "", _
                      "", "=", "", _
                      "roadid", "=", Sheets("Menu").Range("S2").Value, _
                      "", "<", "", _
                      "", ">=", "", _
                      "", "<=", "", _
                      Sheets("Menu").Range("AN7"), _
                      "Roadname", False, True
                      ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
                      
End Sub

 

[ByteMyzer]

Try something like:

MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" 
MyConnection = MyConnection & "Data Source=" _
    & MyDatabaseFilePathAndName _
    & ";Jet OLEDB:Database Password=" & MyDatabasePassword & ";"

 

[dj_mix]

Try something like:

MyConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" 
MyConnection = MyConnection & "Data Source=" _
    & MyDatabaseFilePathAndName _
    & ";Jet OLEDB:Database Password=" & MyDatabasePassword & ";"

Try it and worked Great !! Thanks so much