White_Nova
01-24-2008, 04:43 AM
Hi All
Wonder if you can have a look at this for me.
I have VBA code (Below) that writes to an access database...
When i try and use the update function it takes way too long to run through the code...
Please let me know what im doing wrong...
Sub MultiWeeks()
Dim SQL As String
Dim filenm As String
filenm = (ActiveWorkbook.Path & "\Store.mdb")
Dim conn As New ADODB.Connection
Dim rst As ADODB.Recordset
Dim rs As ADODB.Recordset
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset
Set rs = New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.CursorType = adOpenStatic
rst.LockType = adLockBatchOptimistic
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & filenm & ";Persist Security Info=False"
conn.Open
Sheets("Multi Weeks").Select
If Range("E11").Value <> "" Then
r = 28 'Starts at row specified
Do While (Range("A" & r).Formula) <> ""
rst.ActiveConnection = conn
rst.Open "Update [Store1] " & _
"set [Club]='" & Range("A" & r).Value & "',[Dev]='" & Range("B" & r).Value & "',[Res]='" & Range("C" & r).Value & _
"',[Unit]='" & Range("D" & r).Value & _
"',[Mod]='" & Range("E" & r).Value & _
"',[Size]='" & Range("F" & r).Value & _
"',[RCI]='" & Range("G" & r).Value & _
"',[Sea]='" & Range("H" & r).Value & _
"',[Wee]='" & Range("I" & r).Value & _
"', [TranSt]='" & Range("J" & r).Value & _
"', [ShaCertno]='" & Range("K" & r).Value & _
"', [StocSource]='" & Range("L" & r).Value & _
"', [StartDate]='" & Range("M" & r).Value & _
"', [FinDate]='" & Range("N" & r).Value & _
"', [WeekType]='" & Range("O" & r).Value & _
"', [ArrDate]='" & Range("P" & r).Value & _
"', [Other2007]='" & Range("AC" & r).Value & "', [paidother2007]= '" & Range("AD" & r).Value & "', [RentBud2008]='" & Range("AU" & r).Value & "', [RentPaid2008]='" & Range("AV" & r).Value & "', [PaidRent2008]='" & Range("AW" & r).Value & "', [RentInvNo2008]='" & Range("AX" & r).Value & "', [OustRent2008]='" & Range("AY" & r).Value & "', [Uni1]='" & Range("AZ" & r).Value & "', [RentBud2007]='" & Range("AE" & r).Value & "', [RentPaid2007]='" & Range("AF" & r).Value & "', [PaidRent2007]='" & Range("AG" & r).Value & "', [RentinvNo2007]='" & Range("AH" & r).Value & "', [OustRent2007]='" & Range("AI" & r).Value & "', [Levy2006]='" & Range("AJ" & r).Value & "', [ResCode]='" & Range("AK" & r).Value & "', [LevyBud2008]='" & Range("AL" & r).Value & "', [LevyPaid2008]='" & Range("AM" & r).Value & "', [PaidLevy2008]='" & Range("AN" & r).Value & "', [InvNo2008]='" & Range("AO" & r).Value & "', [OustLevy2008]='" & Range("AP" & r).Value & "', [SpecLevy2008]='" & Range("AQ" & r).Value & _
"', [DepDate]='" & Range("Q" & r).Value & _
"', [OrigCurrency]='" & Range("R" & r).Value & _
"', [StocAgNo]='" & Range("S" & r).Value & "', [PaidSpecLevy2008]='" & Range("AR" & r).Value & "', [Other2008]='" & Range("AS" & r).Value & "', [PaidOther2008]='" & Range("AT" & r).Value & _
"', [ManFee]= '" & Range("T" & r).Value & "', [MemFee]='" & Range("U" & r).Value & _
"', [LevyBud2007]='" & Range("V" & r).Value & _
"', [LevyPaid2007]='" & Range("W" & r).Value & "', [PaidLevy2007]='" & Range("X" & r).Value & "' & [InvNo2007]='" & Range("Y" & r).Value & "' & [OustLevy2007]='" & Range("Z" & r).Value & "', [SpecLevy2007]='" & Range("AA" & r).Value & "', [PaidSpecLevy2007]='" & Range("AB" & r).Value & _
"', [ResortCodeID]='" & Range("BB" & r).Value & _
"', [ClubID]='" & Range("BA" & r).Value & "', [Type]='" & Range("BC" & r).Value & "', [Sur]='" & Range("BD" & r).Value & "', [QVCNum]='" & Range("BE" & r).Value & "', [OcDate]='" & Range("BF" & r).Value & _
"' WHERE [Store1].[Uni1]='" & Range("AZ" & r).Value & "'"
r = r + 1 ' next row
Loop
End If
End Sub
Wonder if you can have a look at this for me.
I have VBA code (Below) that writes to an access database...
When i try and use the update function it takes way too long to run through the code...
Please let me know what im doing wrong...
Sub MultiWeeks()
Dim SQL As String
Dim filenm As String
filenm = (ActiveWorkbook.Path & "\Store.mdb")
Dim conn As New ADODB.Connection
Dim rst As ADODB.Recordset
Dim rs As ADODB.Recordset
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset
Set rs = New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.CursorType = adOpenStatic
rst.LockType = adLockBatchOptimistic
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & filenm & ";Persist Security Info=False"
conn.Open
Sheets("Multi Weeks").Select
If Range("E11").Value <> "" Then
r = 28 'Starts at row specified
Do While (Range("A" & r).Formula) <> ""
rst.ActiveConnection = conn
rst.Open "Update [Store1] " & _
"set [Club]='" & Range("A" & r).Value & "',[Dev]='" & Range("B" & r).Value & "',[Res]='" & Range("C" & r).Value & _
"',[Unit]='" & Range("D" & r).Value & _
"',[Mod]='" & Range("E" & r).Value & _
"',[Size]='" & Range("F" & r).Value & _
"',[RCI]='" & Range("G" & r).Value & _
"',[Sea]='" & Range("H" & r).Value & _
"',[Wee]='" & Range("I" & r).Value & _
"', [TranSt]='" & Range("J" & r).Value & _
"', [ShaCertno]='" & Range("K" & r).Value & _
"', [StocSource]='" & Range("L" & r).Value & _
"', [StartDate]='" & Range("M" & r).Value & _
"', [FinDate]='" & Range("N" & r).Value & _
"', [WeekType]='" & Range("O" & r).Value & _
"', [ArrDate]='" & Range("P" & r).Value & _
"', [Other2007]='" & Range("AC" & r).Value & "', [paidother2007]= '" & Range("AD" & r).Value & "', [RentBud2008]='" & Range("AU" & r).Value & "', [RentPaid2008]='" & Range("AV" & r).Value & "', [PaidRent2008]='" & Range("AW" & r).Value & "', [RentInvNo2008]='" & Range("AX" & r).Value & "', [OustRent2008]='" & Range("AY" & r).Value & "', [Uni1]='" & Range("AZ" & r).Value & "', [RentBud2007]='" & Range("AE" & r).Value & "', [RentPaid2007]='" & Range("AF" & r).Value & "', [PaidRent2007]='" & Range("AG" & r).Value & "', [RentinvNo2007]='" & Range("AH" & r).Value & "', [OustRent2007]='" & Range("AI" & r).Value & "', [Levy2006]='" & Range("AJ" & r).Value & "', [ResCode]='" & Range("AK" & r).Value & "', [LevyBud2008]='" & Range("AL" & r).Value & "', [LevyPaid2008]='" & Range("AM" & r).Value & "', [PaidLevy2008]='" & Range("AN" & r).Value & "', [InvNo2008]='" & Range("AO" & r).Value & "', [OustLevy2008]='" & Range("AP" & r).Value & "', [SpecLevy2008]='" & Range("AQ" & r).Value & _
"', [DepDate]='" & Range("Q" & r).Value & _
"', [OrigCurrency]='" & Range("R" & r).Value & _
"', [StocAgNo]='" & Range("S" & r).Value & "', [PaidSpecLevy2008]='" & Range("AR" & r).Value & "', [Other2008]='" & Range("AS" & r).Value & "', [PaidOther2008]='" & Range("AT" & r).Value & _
"', [ManFee]= '" & Range("T" & r).Value & "', [MemFee]='" & Range("U" & r).Value & _
"', [LevyBud2007]='" & Range("V" & r).Value & _
"', [LevyPaid2007]='" & Range("W" & r).Value & "', [PaidLevy2007]='" & Range("X" & r).Value & "' & [InvNo2007]='" & Range("Y" & r).Value & "' & [OustLevy2007]='" & Range("Z" & r).Value & "', [SpecLevy2007]='" & Range("AA" & r).Value & "', [PaidSpecLevy2007]='" & Range("AB" & r).Value & _
"', [ResortCodeID]='" & Range("BB" & r).Value & _
"', [ClubID]='" & Range("BA" & r).Value & "', [Type]='" & Range("BC" & r).Value & "', [Sur]='" & Range("BD" & r).Value & "', [QVCNum]='" & Range("BE" & r).Value & "', [OcDate]='" & Range("BF" & r).Value & _
"' WHERE [Store1].[Uni1]='" & Range("AZ" & r).Value & "'"
r = r + 1 ' next row
Loop
End If
End Sub