Hello,
I am by no means an expert / teach myself as I go, so please keep that in mind. I have created code to either create a new or update an existing access DB using ADODB through VBA for Excel. Everything works perfectly, but the resulting database files are very large (26MB). They can be brought back down to normal size (1MB) using the Compact/Repair feature within Access, but that's very inefficient/time-consuming. Can anyone take a look / offer some suggestions? Relevant code is posted below. I'm also open to any other suggestions on the code in general if something looks inefficient.
Thanks!!
Code:
Sub Update_DB_OnTime()
If Range("error_check") = True Then
DoEvents
Application.OnTime Now() + TimeValue("00:00:01"), "Update_DB_OnTime"
Exit Sub
Else
Dim dbConn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim dbLoc As String
Dim connect As String, strSQL As String
Dim dbName As String
dbName = Range("contract_code") & ".accdb"
dbLoc = "C:\...Folder Location...\" & dbName
Set dbConn = New ADODB.Connection
connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
connect = connect & "Data Source="
connect = connect & dbLoc
dbConn.Open connect
strSQL = "SELECT * FROM Table1"
Set rs = New ADODB.Recordset
rs.Open strSQL, dbConn, adOpenKeyset, adLockOptimistic
Update_DB rs
rs.Close
Set rs = Nothing
dbConn.Close
Set dbConn = Nothing
End If
Sub Update_DB(rs As ADODB.Recordset)
Dim start_record As Integer
If Cells(Range("record_count") + 2, 18) = Cells(Range("record_count_old") + 2, 3) Then
start_record = Range("record_count_old")
rs.Move (start_record)
Else
start_record = 0
If rs.BOF <> rs.EOF Then
rs.MoveFirst
End If
End If
With rs
For i = start_record To Range("record_count") - 1
If Cells(i + 3, 16) <> "" Then
If .EOF Then
.AddNew
.MoveLast
End If
For j = 1 To rs.Fields.Count - 1
If IsError(Cells(i + 3, j + 16)) Then
With Worksheets("Error Log")
.Calculate
.Range("C3").Offset(Range("error_count"), 0) = Range("contract_code")
.Range("D3").Offset(Range("error_count"), 0) = Cells(i + 3, 1 + 16)
.Range("E3").Offset(Range("error_count"), 0) = Cells(2, j + 16)
End With
Else
.Fields(j).Value = Cells(i + 3, j + 16)
.Update
End If
Next
.MoveNext
End If
Next
End With
End Sub