I am building a workbook that needs to import data from 1) external csv file, 2) external Excel file, 3) in addition l then need to run a query within the workbook on the imported data. This needs to work in both 32bit and 64bit so l believe l am restricted to the Microsoft.ACE.OLEDB.12.0 driver. The 'bare bones' code below works fine for several rapid fire iterations but then will stop working. If l use early binding the workbook gets closed, if l use late binding the error is highlighted at the cn.open line. Trial & error testing seems to suggest that the problem materialises afetr running the query several times for either of the Excel queries, then running the CSVTXT query, then going back to run either of the Excel queries. I have been doing much 'Googling' and have been working on this for 2 or 3 days so far and just cannot find the right answer Any help would really be greatly appreciated.
Below are 3 'Example' procedures that l run in quick succession for testing purposes, followed by the procedures to for CSVTXT files and Excel files.
Below are 3 'Example' procedures that l run in quick succession for testing purposes, followed by the procedures to for CSVTXT files and Excel files.
VBA Code:
Sub Example_SQL_CSVTXT_GetDataWriteToTarget_FromEXTERNAL_CSVTXT()
Dim sSourceFullFilepath As String
Dim rngDataTarget As Range
Dim sSQLQuery As String
' Define variables
sSQLQuery = "SELECT * FROM [xxxMB_F03116020171005.csv];"
sSourceFullFilepath = ThisWorkbook.Path & "\SourceFiles\" & "xxxMB_F03116020171005.csv"
Set rngDataTarget = ThisWorkbook.Worksheets(Target.Name).Range("A1")
' Execute the called procedure
Call SQL_CSVTXT_GetData_WriteToTarget(sSQLQuery, sSourceFullFilepath, rngDataTarget)
Set rngDataTarget = Nothing
End Sub
Sub Example_SQL_EXCEL_GetDataWriteToTarget_FromTHISWORKBOOK()
Dim sSourceFullFilepath As String
Dim rngDataTarget As Range
Dim sSQLQuery As String
' Define variables
sSQLQuery = "SELECT * FROM [myExcelDataInternal$];"
sSourceFullFilepath = ThisWorkbook.FullName
Set rngDataTarget = ThisWorkbook.Worksheets(Target.Name).Range("A1")
' Execute the called procedure
Call SQL_EXCEL_GetData_WriteToTarget(sSQLQuery, sSourceFullFilepath, rngDataTarget)
Set rngDataTarget = Nothing
End Sub
Sub Example_SQL_EXCEL_GetDataWriteToTarget_FromEXTERNALEXCELFILE()
Dim sSourceFullFilepath As String
Dim rngDataTarget As Range
Dim sSQLQuery As String
' Define variables
sSQLQuery = "SELECT * FROM [myExcelData$];"
sSourceFullFilepath = ThisWorkbook.Path & "\SourceFiles\" & "xxxMB_F_xlsb.xlsb"
Set rngDataTarget = ThisWorkbook.Worksheets(Target.Name).Range("A1")
' Execute the called procedure
Call SQL_EXCEL_GetData_WriteToTarget(sSQLQuery, sSourceFullFilepath, rngDataTarget)
Set rngDataTarget = Nothing
End Sub
Sub SQL_CSVTXT_GetData_WriteToTarget(sSQL As String, sDonorFile As String, rngDestination As Range)
On Error GoTo myerrortrap
' EARLY BINDING
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Constants (required for late binding)
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adCmdText = &H1
' Other variables
Dim sCONSTRING As String
Dim sPathOnly As String
' Define the connection string
sPathOnly = Left(sDonorFile, InStrRev(sDonorFile, "\"))
sCONSTRING = "Data Source=" & sPathOnly & ";" & "Extended Properties=""text;HDR=No;FMT=Delimited;"""
' Make connection to the source
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.connectionString = sCONSTRING
.Open
End With
' Build the recordset (change arguments for 'CursorType' & 'Lock Type' if you need to move through or manipulate the recordset)
rs.Open Source:=sSQL, ActiveConnection:=cn, CursorType:=adOpenForwardOnly, LockType:=adLockReadOnly, Options:=adCmdText
' Write recordset to destination
rngDestination.CopyFromRecordset rs
' Close connection and recordset
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Exit Sub
myerrortrap:
Debug.Print Err.Source & ", " & Err.Description
End Sub
Sub SQL_EXCEL_GetData_WriteToTarget(sSQL As String, sDonorFile As String, rngDestination As Range)
On Error GoTo myerrortrap
' EARLY BINDING
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Constants (required for late binding)
Const adOpenForwardOnly = 0
Const adLockReadOnly = 1
Const adCmdText = &H1
' Other variables
Dim sCONSTRING As String
' Define the connection string
sCONSTRING = "Data Source=" & sDonorFile & ";" & "Extended Properties=""Excel 12.0;HDR=NO;"""
' Make connection to the source
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.connectionString = sCONSTRING
.Open
End With
' Build the recordset
rs.Open Source:=sSQL, ActiveConnection:=cn, CursorType:=adOpenForwardOnly, LockType:=adLockReadOnly
' Write recordset to destination
rngDestination.CopyFromRecordset rs
' Close connection and recordset
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Exit Sub
myerrortrap:
Debug.Print Err.Source & ", " & Err.Description
End Sub
Last edited by a moderator: