Excel VBA Code Error (Asks me to enter Microsoft Access Database Engine OLE DB-Initialization Information)

Question

I'm currently creating a function in VBA that generates a query automatically if you press a button. The code runs without error, initially, but when I fill out the input boxes correctly, it pops up a window that says "Please Enter Microsoft Access Database Engine OLE DB Initialization Information", and then gives me the choice to fill in data source, user admin, password, provider string, and open mode. Each box is filled out besides password. I don't have access to this information, but it shouldn't in the first place, pop this wndow up. In the code, I reference to an excel sheet which pulls certain information from the report (specifically the columns) and creates a query using these columns where the month and year are a certain date. Then, I aim to move the query to a different Excel workbook, and list them in a sheet over there. However, I continue to receive the same error (When I press the cancel button in the window, the place of error is on the .Refresh BackgroundQuery.). This is the code :

Sub GenerateQuery()
    Dim targetMonth As String
    targetMonth = InputBox("Enter the target month (e.g., January):")
    
    

    Select Case LCase(targetMonth)
     Case "january", "february", "march", "april", "may", "june", "july", "august", "september", "october", "november", "december"
          
     Case Else
         MsgBox "Please enter a valid month name."
         ' Prompt user for input again or exit the code, based on your requirement
         Exit Sub ' Exits the sub-routine
    End Select
    Dim targetYear As String
    targetYear = InputBox("Enter the target year (e.g., 2023):")
    
 
    If Not IsNumeric(targetYear) Or Len(targetYear) <> 4 Then
    MsgBox "Invalid year format. Please enter a four-digit year.", vbExclamation
    Exit Sub ' Exit the code if input is invalid
    End If

    Dim columnList As String
    columnList = "[Invoice Id], [Invoice Date], FORMAT([Invoice Date], ""mmm-dd"") AS [Formatted Date], [Serial], [Purch Id], [Item Id], [Sell Price], [Revenue Share], [Vendor]"


    Dim query As String
    query = "SELECT " & columnList & " FROM [tbl_Cons_Rpt] WHERE MONTH([Invoice Date]) = " & Month(DateValue(targetMonth & " 1")) & " AND YEAR([Invoice Date]) = " & targetYear & " AND [Vendor] = 'V005501 - Atlantic Broadband ARP'"
 
    Dim targetWorkbook As Workbook
    Set targetWorkbook = Workbooks.Open("C:\Users\notgonnashow.xlsx")

    targetWorkbook.Sheets("qry_ABB1").UsedRange.ClearContents

    Dim tableDestination As Range
    Set tableDestination = targetWorkbook.Sheets("qry_ABB1").Range("A1")



    With targetWorkbook.Sheets("qry_ABB1").ListObjects.Add( _
    SourceType:=xlSrcQuery, _
    Source:="OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & targetWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";", _
    Destination:=tableDestination).QueryTable
    .CommandType = xlCmdSql
    .CommandText = query
    .Refresh BackgroundQuery:=False
    
     
End With

targetWorkbook.Close SaveChanges:=True ' Modify later if needed
End Sub

Not sure whats going on. Any help would be appreciated to fix this problem. Thanks!

Tim Williams · Accepted Answer · 2023-06-22 20:23:43Z

It might seem that you should be able to use a listobject name directly in a query using that driver, but you can't, so you need to sub in the address of the listobject's range...

For example:

Sub AddListObject()
    
    Dim wsQuery As Worksheet, connStr As String, wbSource As Workbook
    Dim SrcAddr As String
    
    Set wbSource = Workbooks.Open("C:\Temp\sourceData.xlsx")
    Set wsQuery = wbSource.Worksheets("Query")
    
    connStr = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;" & _
               "Data Source=""" & wbSource.FullName & _
               """;Extended Properties=""Excel 12.0 Xml;HDR=YES"" "
    
    SrcAddr = ListAddress(wbSource, "MyDataTable") 'can't use the table name directly in a query
    
    If wsQuery.ListObjects.Count > 0 Then wsQuery.ListObjects(1).Delete
    wsQuery.UsedRange.Clear
    
    With wsQuery.ListObjects.Add(SourceType:=0, Destination:=wsQuery.Range("A1"), _
                            Source:=connStr, XlListObjectHasHeaders:=xlYes)
       .Name = "qry_ABB1"
       .QueryTable.CommandType = xlCmdSql
       .QueryTable.CommandText = "select * from " & SrcAddr & " where Col0001 >0.5"
       .QueryTable.Refresh
    End With

End Sub

'See https://stackoverflow.com/a/33235302/478884
'search a workbook for a listobject named `ListName` and
'  return it's address, including the sheet name
Public Function ListAddress(wb As Workbook, ListName As String) As String
    Dim oListObject As ListObject, ws As Worksheet
    For Each ws In wb.Sheets
        For Each oListObject In ws.ListObjects
            If oListObject.Name = ListName Then
                ListAddress = "[" & ws.Name & "$" & oListObject.Range.Address(False, False) & "]"
                Exit Function
            End If
        Next oListObject
    Next ws
End Function

Collectives™ on Stack Overflow

Excel VBA Code Error (Asks me to enter Microsoft Access Database Engine OLE DB-Initialization Information)

1 Answer 1

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related