I couldn't see where my table aliases were wrong; however, I went ahead and copy/pasted your re-writes of them, and still got syntax errors. I tried to simplify the query and now it doesn't even run. Well, it ran once successfully, but never again. Now the rs.open statement keeps getting:
Input files:
MasterFile.xlsm, Raw Data worksheet:
Hostname | IP Address | OS Type | Vendor | Name |
hostname2 | xyz | Server | myvendor2 | yyy |
hostname1 | xyz | Server | myvendor | xxx |
hostname2 | xyz | Server | myvendor2 | yyy |
hostname1 | xyz | Server | myvendor | xxx |
hostname3 | xyz | Server | myvendor3 | zzz |
hostname1 | xyz | Server | myvendor | xxx |
hostname3 | xyz | Server | myvendor3 | zzz |
hostname1 | xyz | Server | myvendor | www |
hostname4 | xyz | Server | myvendor | xxx |
hostname3 | xyz | Server | myvendor3 | zzz |
PowerBi2.xlsx, Sheet1 worksheet:
Owner | Hostname | IP Address | Asset Type | Vendor | Family | Name |
Smith, John | Hostname1 | xyz | Server | myvendor1 | | xxx |
Smith, John | Hostname2 | xyz | Server | myvendor2 | | yyy |
Smith, John | Hostname1 | xyz | Server | myvendor1 | | xxx |
Smith, John | Hostname3 | xyz | Client | myvendor3 | | zzz |
Smith, John | Hostname4 | xyz | Server | myvendor4 | | www |
Smith, John | Hostname1 | xyz | Server | myvendor1 | | yyy |
Smith, John | Hostname1 | xyz | Server | myvendor1 | | yyy |
Smith, John | Hostname1 | xyz | Server | myvendor1 | | yyy |
Smith, John | Hostname3 | xyz | Client | myvendor3 | | zzz |
Smith, John | Hostname2 | xyz | Server | myvendor2 | | yyy |
Here is the SQL formatted:
Here is the full program:
Sub Report1a()
Dim Sql As String
Sql = "SELECT m.hostname, m.[IP Address], m.[OS Type], m.vendor, m.name " & _
" FROM [Raw Data$] AS m in 'C:\Users\U37T19\Documents\VarunArora\VbaSql\MasterFile.xlsm' 'Excel 12.0 Xml;HDR=YES'"
'Run the query with the SQL string
ExecuteSql1 Sql
End Sub
Sub ExecuteSql1(Sql As String)
Dim filePath As String
Dim master As String
Dim cn As ADODB.connection
Dim rs As ADODB.Recordset
Dim ws As Worksheet
Dim i As Integer
Dim RowCount As Long, ColCount As Long
master = "MasterFile.xlsm"
Workbooks(master).Worksheets("Raw Data").Activate
'Exit the procedure if no query was passed in
If Sql = "" Then
MsgBox _
Prompt:="You didn't enter a query", _
Buttons:=vbCritical, _
Title:="Query string missing"
Exit Sub
End If
'Check that the Menu workbook exists in the same folder as this workbook
filePath = ActiveWorkbook.Path & "\" & master
If Dir(filePath) = "" Then
MsgBox _
Prompt:="Could not find " & master, _
Buttons:=vbCritical, _
Title:="File not found"
Exit Sub
End If
Set cn = New ADODB.connection
cn.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & filePath & ";" & _
"Extended Properties='Excel 12.0 Xml;HDR=YES';"
'Try to open the connection, exit the subroutine if this fails
On Error GoTo EndPoint
cn.Open
'If anything fails after this point, close the connection before exiting
On Error GoTo CloseConnection
'Create and populate the recordset using the SQLQuery
Set rs = New ADODB.Recordset
rs.ActiveConnection = cn
rs.CursorType = adOpenStatic
rs.Source = Sql 'Use the query string that we passed into the procedure
'Try to open the recordset to return the results of the query
rs.Open
'If anything fails after this point, close the recordset and connection before exiting
On Error GoTo CloseRecordset
' make it so this program works on the Movies.xlsx file and not personal.xlsb
Set ws = ActiveWorkbook.ActiveSheet
'Get count of rows returned by the query
RowCount = rs.RecordCount
'Exit the procedure if no rows returned
If RowCount = 0 Then
MsgBox _
Prompt:="The query returned no results", _
Buttons:=vbExclamation, _
Title:="No Results"
Exit Sub
End If
'Get the count of columns returned by the query
ColCount = rs.Fields.Count
'Create a new worksheet
Set ws = ActiveWorkbook.Worksheets.Add
'Select the worksheet to avoid the formatting bug with CopyFromRecordset
ActiveWorkbook.Activate
ws.Select
'Format the header row of the worksheet
With ws.Range("A1").Resize(1, ColCount)
'.Interior.Color = rgbCornflowerBlue
'.Font.Color = rgbWhite
.Font.Bold = True
End With
'Copy values from the recordset into the worksheet
ws.Range("A2").CopyFromRecordset rs
'Write column names into row 1 of the worksheet
For i = 0 To ColCount - 1
With rs.Fields(i)
ws.Range("A1").Offset(0, i).Value = .Name
'Apply a custom date format to date columns
If .Type = adDate Then
ws.Range("A1").Offset(1, i).Resize(RowCount, 1).NumberFormat = "yyyy-mm-dd"
End If
End With
Next i
'Change the column widths on the worksheet
ws.Range("A1").CurrentRegion.EntireColumn.AutoFit
'Close the recordset and connection
'This will happen anyway when the local variables go out of scope at the end of the subroutine
rs.Close
cn.Close
'Free resources used by the recordset and connection
'This will happen anyway when the local variables go out of scope at the end of the subroutine
Set rs = Nothing
Set cn = Nothing
'Exit here to make sure that the error handling code does not run
Exit Sub
'========================================================================
'ERROR HANDLERS
'========================================================================
CloseRecordset:
'If the recordset is opened successfully but a runtime error occurs later we end up here
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
Debug.Print Sql
MsgBox _
Prompt:="An error occurred after the recordset was opened." & vbNewLine _
& vbNewLine & "Error number: " & Err.Number _
& vbNewLine & "Error description: " & Err.Description, _
Buttons:=vbCritical, _
Title:="Error After Recordset Open"
Exit Sub
CloseConnection:
'If the connection is opened successfully but a runtime error occurs later we end up here
cn.Close
Set cn = Nothing
Debug.Print Sql
MsgBox _
Prompt:="An error occurred after the connection was established." & vbNewLine _
& vbNewLine & "Error number: " & Err.Number _
& vbNewLine & "Error description: " & Err.Description, _
Buttons:=vbCritical, _
Title:="Error After Connection Open"
Exit Sub
'If the connection failed to open we end up here
EndPoint:
MsgBox _
Prompt:="The connection failed to open." & vbNewLine _
& vbNewLine & "Error number: " & Err.Number _
& vbNewLine & "Error description: " & Err.Description, _
Buttons:=vbCritical, _
Title:="Connection Error"
End Sub
