I have a program that requires a weekly update. Excel is used as a front end application and Access is used to house the data. The people running this do not have Access but need to upload the data into it. Currrently I'm going row by row to upload the data and it's taking longer than I think it should. In fact this would be a weekly update of about 10K+ rows of data and it's taking over 30 min. It should be something like this:
Range.Copy
Table.Paste
I know it's not that simple but that's what I'm trying to do. Is it possible?
My current code:
Sub grabData
Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM [Database]", cn, adOpenKeyset, adLockOptimistic, adCmdText
Set rng = dataSht.Cells.Find("Customer").Offset(1, 0)
With dataSht
Do
rs.Filter = "[Customer] = '" & .Cells(rng.Row, columns(1)).Value & "' AND " & _
"[Calendar week] = '" & .Cells(rng.Row, columns(3)).Value & "' AND " & _
"[Plant] = '" & .Cells(rng.Row, columns(4)).Value & "' AND " & _
"[Material] = '" & .Cells(rng.Row, columns(7)).Value & "'"
If rs.EOF Then
Call addThisLine
Else
Call updateThisLine
End If
Set rng = rng.Offset(1, 0)
Loop Until IsEmpty(rng) = True
End With
End Sub
Private Sub addThisLine()
With rs
.AddNew
For x = 1 To 12
rs.Fields(x - 1) = dataSht.Cells(rng.Row, columns(x))
Next x
.Update
End With
End Sub
Private Sub updateThisLine()
With rs
For x = 9 To 12
rs.Fields(x - 1) = dataSht.Cells(rng.Row, columns(x))
Next x
.Update
End With
End Sub
Range.Copy
Table.Paste
I know it's not that simple but that's what I'm trying to do. Is it possible?
My current code:
Sub grabData
Set rs = New ADODB.Recordset
rs.Open "SELECT * FROM [Database]", cn, adOpenKeyset, adLockOptimistic, adCmdText
Set rng = dataSht.Cells.Find("Customer").Offset(1, 0)
With dataSht
Do
rs.Filter = "[Customer] = '" & .Cells(rng.Row, columns(1)).Value & "' AND " & _
"[Calendar week] = '" & .Cells(rng.Row, columns(3)).Value & "' AND " & _
"[Plant] = '" & .Cells(rng.Row, columns(4)).Value & "' AND " & _
"[Material] = '" & .Cells(rng.Row, columns(7)).Value & "'"
If rs.EOF Then
Call addThisLine
Else
Call updateThisLine
End If
Set rng = rng.Offset(1, 0)
Loop Until IsEmpty(rng) = True
End With
End Sub
Private Sub addThisLine()
With rs
.AddNew
For x = 1 To 12
rs.Fields(x - 1) = dataSht.Cells(rng.Row, columns(x))
Next x
.Update
End With
End Sub
Private Sub updateThisLine()
With rs
For x = 9 To 12
rs.Fields(x - 1) = dataSht.Cells(rng.Row, columns(x))
Next x
.Update
End With
End Sub