Import MS Access database query into Excel using VBA without logging in

Question

I am trying to import an MS Access request into excel without prompting a login prompt. I tried to perform this operation in several different ways, but both methods did not give me a complete solution.

Features:

• The source of the access request is an unprotected access database file (database1.accdb) built into MS Access 2010. This database receives tables from different sources (using linked tables) and performs data processing. One of these sources requires a password, so when I run the request, a login prompt appears asking me for the credentials (which I have). I have no problem with the request itself.

• My Excel spreadsheet (built into excel 2010) contains VBA code that retrieves tables from other data sources, and some of them require authentication, so I created a custom prompt that allows the user to enter credentials for all tables.

The problem is that I have an invitation that appears in an Excel spreadsheet that asks the user for login information, but then a new prompt appears when importing the access request. Here is what I tried to do to deal with the problem:

Method 1: Using Macro Recorder:

I used excel built into the macro recorder to follow my control steps when importing an access request. When I record a macro, the import works, and the request arrives without 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 about why this macro does not work (but the steps are performed manually) is that some parameters are ignored by the recorder. If I remove the quotation marks from some password fields, the code will not fail, but I will again send a login request. I was hoping someone here would see if there is 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 link to my editor for the “Microsoft DAO 3.6 Object Library”. Then I had to hide the .accdb file in the .mdb file so that I could use the DAO functions:

Code for the 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 get around the database login hint ... until my query returns a large number of records. When I returned to ~ 60,000 records, the code would not take more than 5-10 seconds to get the result. However, when I tried to pull out more than 100,000 records, excel will stop responding and hang up (I missed the code for about 10 minutes before I stopped it). I think I hit some restrictions on the DAO, other than that I cannot find the documentation that addresses this.

Any help is appreciated.

Answer 1

I did some more research and testing and was able to break out of this hole. The reason excel freezes when using the CopyFromRecordset method is because I tried to import more than 65,000 records at the same time. Apparently, MS Access did not succeed when its record limit was increased from 65,000 to 1,000,000 entries.

What I did for a workaround was to open a query and get smaller pieces of records (<= 65,000) at a time 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 would like to point out a few things that I met in building code:

• The dbOpenSnapshot parameter in the OpenRecordset method OpenRecordset important because other parameters (for example, dbOpenDynamic) can more than double the execution time depending on the number of operations.
• This macro can be modified if it is used in a 64-bit environment.
• The CopyFromRecordset method does not automatically return field headers, so I added a loop to do this in advance.
• The CopyFromRecordset method does not give the user any indication if the process is complete or not, so I added status line messages using the Application.StatusBar property.
• Although the loop stops when the end of the file is reached, I still got a runtime error when the last record was imported before the next iteration of the loop, so I added the end of the file check at the end of the loop.

Thus, this code allows me to effectively stop access to MS Access to give me a login prompt when I try to import an Access request whose source is protected. This is not the same protection as in the .mdb file itself (which can be specified in the file connection string).

Answer 2

Try the following:

 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 full request in a 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