PDA

View Full Version : RecordSet Slows VBA



Atravis
03-08-2011, 05:32 AM
Good Afternoon,
I have a Macro which reads in a large amount of data from a CSV and then uses Recordsets to match records off against a mapping table. On running the macro once is very quick (2seconds) however on running it again this slows dramatically (22seconds). I've managed to deduce that it is the line which create the recordset which dramatically slows the process, so i am presuming the code does not properly close the set. If anyone has any idea how I would go about this properly I would be very grateful.



Sub RecordSet_Match()
Dim ObjConnection As ADODB.Connection, ObjRecordset3 As ADODB.Recordset

'set record set variables
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1

'ser connection and recordset
Set ObjConnection = CreateObject("ADODB.Connection")
Set ObjRecordset3 = CreateObject("ADODB.Recordset")
Set ObjConnection = GetExcelConnection(ThisWorkbook.FullName)

'first table (sheet s5)
rs1 = "[" & s5.Name & "$" & s5.UsedRange.Address(False, False) & "]"

'second table (sheet s10)
rs2 = "[" & s10.Name & "$" & s10.UsedRange.Address(False, False) & "]"

'join tables on s5.cell(i,"A")=s10.cell(j,"B") and s5.cell(i,"H")=s10.cell(j,"A") , and only take these records using Where statment. It is this line which causes the macro to slow

ObjRecordset3.Open "SELECT T1.*,T2.F3,T2.F4 FROM " & rs1 & " AS T1 LEFT JOIN " & rs2 & " AS T2 ON T1.F1=T2.F2 AND T1.F8=T2.F1 WHERE T1.F8=T2.F1", _
ObjConnection, adOpenStatic, adLockOptimistic, adCmdText

'clear sheet s11 and copy in data from recordset

s11.UsedRange.Clear
s11.Cells(1, "A").CopyFromRecordset ObjRecordset3
Application.CutCopyMode = False

'close everything and set to nothing
ObjRecordset3.Close
ObjConnection.Close
Set objConnection3 = Nothing
Set ObjRecordset = Nothing
End Sub

'set up a connection (used with xls), set not to use headers
Public Function GetExcelConnection(ByVal Path As String, _
Optional ByVal Headers As Boolean = False) As Connection
Dim strConn As String
Dim objConn As ADODB.Connection

'set connection (use excel 8, mixed data as text and headers set off as standard)
Set objConn = New ADODB.Connection
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Path & ";" & _
"Extended Properties=""Excel 8.0;IMEX=1;HDR=" & _
IIf(Headers, "Yes", "No") & """"

'open connection
objConn.Open strConn

'give back connection
Set GetExcelConnection = objConn
End Function