4

I am trying to import an MS Access query into excel without triggering the log-in prompt. I have attempted this operation a few different ways, but both methods haven't given me a complete solution.

Specifics:

  1. My access query source is an unprotected access database file (database1.accdb) built in MS Access 2010. This database gets tables from different sources (by use of linked tables) and performs data processing. One of these sources requires a password, so when I run the query, a log-in prompt comes up asking me for credentials (which I have). I have no issues with the query itself.

  2. My excel spreadsheet (built in excel 2010) contains VBA code that retrieves tables from other data sources and some of them require authentication as well, so I built a custom prompt that lets a user enter credentials for all the tables.

The problem here is that I have a prompt coming up in the excel spreadsheet that asks the user for log-in information, but then another prompt comes up when the access query is imported. Here's what I've tried to do to handle the problem:

Method 1: Using the Macro Recorder:

I used excel's built in macro recorder to follow my manual steps in importing the access query. When I'm recording the macro, the imports works and the query comes in with no errors as expected. However, when I try to run the macro, I get a runtime error:

"Run-time error '1004':

The query did not run, or the database could not be opened. Check the database  
server or contact your database administrator. Make sure the external database  
is available and has not been moved or reorganized, then try the operation  
again."

Code from Macro Recorder:

Sub Macro2()
    
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;" _
        , "Data Source=C:\Database1.accdb;Mode=Share Deny Write;" _
        , "Extended Properties="""";Jet OLEDB:System database="""";" _
        , "Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";" _
        , "Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=0;" _
        , "Jet OLEDB:Global Partial Bulk Ops=2;" _
        , "Jet OLEDB:Global Bulk Transactions=1;" _
        , "Jet OLEDB:New Database Password="""";" _
        , "Jet OLEDB:Create System Database=False;" _
        , "Jet OLEDB:Encrypt Database=False;" _
        , "Jet OLEDB:Don't Copy Locale on Compact=False;" _
        , "Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;" _
        , "Jet OLEDB:Support Complex Data=False;" _
        , "Jet OLEDB:Bypass UserInfo Validation=False"), _
        Destination:=Range("$A$4")).QueryTable
        .CommandType = xlCmdTable
        .CommandText = Array("Query3")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = "C:\Database1.accdb"
        .ListObject.DisplayName = "Table_Database1"
        .Refresh BackgroundQuery:=False
    End With
    Range("I3").Select
   
End Sub

My guess as to why this macro doesn't work (but the manual steps do) is because some parameters are ignored by the recorder. If I removed the quotes from some of the password fields, the code doesn't error out, but I get the log-in prompt again. I was hoping someone on here can see if there's a missing parameter or an incorrectly assigned parameter.

Method 2: Using the DAO Library:

For this method, I had to make a few changes. First I had to add a reference in my editor for "Microsoft DAO 3.6 Object Library". Then I had to covert my .accdb file to a .mdb file so I can use the DAO functions:

Code for DAO Method:

Sub Macro3()

    Dim db1 As Database
    Dim db2 As Database
    Dim recSet As Recordset
    Dim strConnect As String
   
    Set db1 = OpenDatabase("C:\Database1.mdb")
    strConnect = db1.QueryDefs("Query3").Connect _
    & "DSN=myDsn;USERNAME=myID;PWD=myPassword"
   
    Set db2 = OpenDatabase("", False, False, strConnect)
    db2.Close
    Set db2 = Nothing
   
    Set recSet = db1.OpenRecordset("Query3")
   
    With ActiveSheet.QueryTables.Add(Connection:=recSet, Destination:=Range("$A$4"))
        .Name = "Connection"
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
 
    End With
   
    recSet.Close
    db1.Close
    Set recSet = Nothing
    Set db1 = Nothing
   
End Sub

This method works and I can bypass the database's log-in prompt... as long as my query doesn't return a large amount of records. When I was returning up to ~60,000 records, the code would not take more than 5-10 seconds to get a result. However, when I tried pulling more than ~100,000 records, excel would become unresponsive and hang (I let the code run for about 10 minutes before I stopped it). I'm thinking I've hit some limitation on the DAO, other than that I can't find documentation that addresses this.

Any assistance is appreciated.

Improve this question
0

2 Answers 2

Reset to default
4

Try this :

Sub ShowData()


   Dim daoDB            As DAO.Database
   Dim daoQueryDef      As DAO.QueryDef
   Dim daoRcd           As DAO.Recordset

    Set daoDB = OpenDatabase("C:\Database1.mdb")  
    Set daoQueryDef = daoDB.QueryDefs("Query3")

    Set daoRcd = daoQueryDef.OpenRecordset
    ThisWorkbook.Worksheets("Sheet1").Range("A4").CopyFromRecordset daoRcd


End Sub

OR this...in this case you need to write your complete query in VBA window

Sub new1()

    Dim objAdoCon       As Object
    Dim objRcdSet       As Object

    Set objAdoCon = CreateObject("ADODB.Connection")
    Set objRcdSet = CreateObject("ADODB.Recordset")    


     objAdoCon.Open "Provider = Microsoft.Jet.oledb.4.0;Data Source = C:\Database1.mdb" 
     objRcdSet.Open "Write ur Query Here", objAdoCon

     ThisWorkbook.Worksheets("Sheet1").Range("A1").CopyFromRecordset objRcdSet

    Set objAdoCon = Nothing
    Set objRcdSet = Nothing

End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

5 Comments

I tried the first suggestion and I ran into the same issue as my method 2. The operation becomes very slow and hangs (I wouldn't say it crashed because I still see memory getting allocated in the resource monitor). As for your second suggestion, I'm not sure I can simply do the whole query in vba. The query I'm retrieving is the last of three queries that are in the same file. Also, I believe I'll run into the same issue again because your using the CopyFromRecordset method
As an update, I think I found why I can't use the CopyFromRecordset method properly. When I try to export one of my large tables to an excel workbook, MS Access returns a message saying that I placed more records than I can fit onto the clipboard and tells me the maximum number is 65,000. This message matches closely with what I was experiencing before when Excel would hang when I brought in more than ~60,000. The message also suggested that I break up my table into smaller groups or limit the number of records I export. Am I able to limit the amount of records CopyFromRecordset returns?
Hi, When you copy data from recordset using copyfromrecordset method...you can specify maxrecords there also e.g ThisWorkbook.Worksheets("Sheet1").Range("A4").CopyFromRecordset daoRcd,65536 what you need is just loop through the recordset till EOF. I hope it will work for you
ThisWorkbook.Worksheets("Sheet1").Range("A4").CopyFromRecordset daoRcd,65536
Nice one Transformer. This is much more elegant than the way I was doing it before. I'm switching over to your method now!
2

I did some more research and testing and was able to get myself out of this hole. The reason why excel would hang when using the CopyFromRecordset method is because I was trying to bring in more than 65,000 records at once. Apparently, MS Access did not follow excel when its record limit was increased from 65,000 to 1,000,000 records.

What I did for a workaround is to open the query and retrieve smaller chunks of records (<=65,000) at a time by using a loop. The code that worked for me is shown below.

Dim daoDB As DAO.Database
Dim daoQueryDef As DAO.QueryDef
Dim daoRcd As DAO.Recordset
Dim daoFld As DAO.Field
Dim i As Integer 'number to track field position
Dim j As LongPtr 'number to track record position (>32,767; cannot be integer)
Dim k As LongPtr 'represents retrieval limit of CopyFromRecordSet method

'notify user of progress
Application.StatusBar = False
Application.StatusBar = "opening query..."

'set up database connection and authentication for query
Set daoDB = OpenDatabase("C:\myFile.mdb")

strConnect = daoDB.QueryDefs("myQuery").Connect _
& "DSN=myDsn;USERNAME=myName;PWD=myPass "
Set daoDB2 = OpenDatabase("", False, False, strConnect)
daoDB2.Close
Set daoDB2 = Nothing

'open the desired query and recordset
Set daoQueryDef = daoDB.QueryDefs("myQuery")
Set daoRcd = daoQueryDef.OpenRecordset(dbOpenSnapshot, dbReadOnly)

'set up the fields in excel
i = 0
With Range("A1")
    For Each daoFld In daoRcd.Fields
    .Offset(0, i).Value = daoFld.Name
    i = i + 1
    Next daoFld
End With

'set up counters and perform record import while updating the user
j = 2
k = 30000
Application.StatusBar = False
Application.StatusBar = "importing... 0"

Do While Not daoRcd.EOF
    ThisWorkbook.Worksheets("Sheet1").Range("A" & j).CopyFromRecordset _
    daoRcd, k
    j = j + k
    Application.StatusBar = False
    Application.StatusBar = "importing... " & j

    'if end of file is reached, end the loop, otherwise continue importing
    If daoRcd.EOF = True Then
    Else
        daoRcd.MoveNext
    End If
Loop

'close the remaining connections
Application.StatusBar = False
daoRcd.Close
daoDB.Close
Set daoRcd = Nothing
Set daoDB = Nothing

Range("A1").Select

I'd like to note a few things I came across in the code building:

  1. The dbOpenSnapshot option in the OpenRecordset method is important, because the other options (such as dbOpenDynamic) could more than double the run-time depending on how many operations there are.
  2. This macro may have to be modified if it will be used in a 64-bit environment.
  3. The CopyFromRecordset method doesn't bring back the field headers automatically, so I added a loop to do this beforehand.
  4. The CopyFromRecordset method doesn't give the user any indication if the process is finished or not, so I added period status bar messages using the Application.StatusBar property.
  5. Even though the loop stops when the end of the file is reached, I was still getting a run-time error when the last record was imported before the start of the next loop iteration, so I added an end-of-file check at the end of the loop.

In summary, this code allows me to effectively stop MS Access from giving me a log-in prompt when I try to import an Access query whose source is protected. This is not the same protection that is found in the .mdb file itself (which can be specified in the connection string to the file).

Improve this answer

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.