Splitting Access database via VBA takes suddenly ages - vba

Question

I have an MS Access database. The database version is 2002-2003 (therefore mdb). From that database I am exporting several fields into a temporary table in order to represent them on a website. As there is a field which has several comma-separated entries, I am splitting them so that each record has only one entry per field.
Imagine a German-English dictionary with the following record:
en | de
building | Gebäude,Bauwerk
I want to split it as follows:
en | de
building | Gebäude
building | Bauwerk
The VBA function that I am using used to work fine. The database has around 100.000 records. Splitting used to take around 30 minutes. Now it takes the whole day.
This is the function:
Public Sub commasplitfield4()
Dim rstObj As DAO.Recordset, dbObj As DAO.Database
Dim InsertSQL As String
Set dbObj = CurrentDb()
Set rstObj = dbObj.OpenRecordset("qry-export")
DoCmd.SetWarnings False
Do While Not rstObj.EOF
Dim memArr() As String
memArr = Split(rstObj.Fields("field4"), ",")
For i = 0 To UBound(memArr)
InsertSQL = "INSERT INTO exporttemp(field1,field2,field3,field4) VALUES (""" & rstObj.Fields("field1") _
& """, """ & rstObj.Fields("field2") _
& """, """ & rstObj.Fields("field3") & """, """ & memArr(i) & """)"
DoCmd.RunSQL (InsertSQL)
Next
rstObj.MoveNext
Loop
DoCmd.SetWarnings True
End Sub
I cannot say when exactly it started to take so long, but I can say that changing from Windows 7 to Windows 10 didn't make a difference. I am on Windows 10 for a long time and it still used to work well. Also moving from Access 2007 to 2010 and then to 2019 didn't make a difference, at least not at once.
In order to check where the error could lie I went through the following checklist:
I compact the database before starting the function
I tried to start Access in Windows 7 compatibility mode
I removed unused fields
I started the performance analyser and made the changes that were proposed (in two fields I changed the data type)
I split the database into a backend only with the tables and a frontend which contains queries and modules
I exported the content of the backend into a text file and re-imported it into a newly created backend
I stopped the Antivirus while performing the function (although Antivirus used very little processor capacity)
None of that made a notable difference.
Any idea?

Answer 1

The by far best answer was the one from HansUp. Instead of a whole day it takes a couple of minutes now. I cannot even thank HansUp properly because he put the solution in a side comment.
Surprisingly, there is actually little that I had to change in the code. So, the solution was to modify the code as follows:
Public Sub commasplitfield4()
Dim rstObj As DAO.Recordset, dbObj As DAO.Database
Dim InsertSQL As String
Set dbObj = CurrentDb()
Set rstObj = dbObj.OpenRecordset("qry-export")
DoCmd.SetWarnings False
Do While Not rstObj.EOF
Dim memArr() As String
memArr = Split(rstObj.Fields("field4"), ",")
For i = 0 To UBound(memArr)
InsertSQL = "INSERT INTO exporttemp(field1,field2,field3,field4) VALUES (""" & rstObj.Fields("field1") _
& """, """ & rstObj.Fields("field2") _
& """, """ & rstObj.Fields("field3") & """, """ & memArr(i) & """)"
'DoCmd.RunSQL (InsertSQL)
dbObj.Execute (InsertSQL), dbFailOnError 'this line made the difference
Next
rstObj.MoveNext
Loop
'DoCmd.SetWarnings True
End Sub

Answer 2

I can't explain the exact cause of your problem, but I think it takes a lot of time to loop through the recordset and loop through the Array.
The task of separating characters with commas seems to be faster using vba in Excel.
The example source data was for 1000000 records,
The contents separated by each comma were written in two per record, and the records of the converted data were tested with data of 2000000.
Import the original data of Access into Excel (Sheets(1)). (Example table2) ~~> 0.7617188 seconds
Convert the data by separating the data of the imported Sheets(1) with commas.
--> Sheets(2) ~~> 21.58594 seconds
Load data from Sheets(2) by Access applicantion.
~~> 5 minutes
Import the original data of Access
Sub exeSQLgetdata()
Dim Rs As ADODB.Recordset
Dim strConn As String
Dim i As Integer
Dim Fn As String
Dim Ws As Worksheet
Dim st, et
st = Timer
Set Ws = Sheets(1)
Fn = ThisWorkbook.Path & "\" & "Database9.accdb" '<~~ your database path & name
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & Fn & ";"
Set Rs = CreateObject("ADODB.Recordset")
strSQL = "Select field1,field2, field3, field4 from [table2]" '<~~ your raw data table
Rs.Open strSQL, strConn
If Not Rs.EOF Then
With Ws
For i = 0 To Rs.Fields.Count - 1
.Cells(1, i + 1) = Rs.Fields(i).Name
Next i
.UsedRange.Offset(1).Clear
.Range("a2").CopyFromRecordset Rs
End With
End If
Rs.Close
Set Rs = Nothing
et = Timer
Debug.Print "Get Data time : " & et - st & " seconds" '<~~ get data from access database
End Sub
Convert the data by separating the data of the imported Sheets(1) with commas.
Sub splitData()
Dim vR(1 To 1000000, 1 To 4)
Dim vDB As Variant
Dim i As Long, n As Long
Dim k As Variant, v As Variant
Dim Ws As Worksheet
Dim toWs As Worksheet
Dim st, et
st = Timer
Set Ws = Sheets(1)
Set toWs = Sheets(2)
vDB = Ws.Range("a1").CurrentRegion
For i = 1 To UBound(vDB, 1)
k = Split(vDB(i, 4), ",")
For Each v In k
n = n + 1
vR(n, 1) = vDB(i, 1)
vR(n, 2) = vDB(i, 2)
vR(n, 3) = vDB(i, 3)
vR(n, 4) = v
Next v
DoEvents
Next i
With toWs
.UsedRange.Clear
.Range("a1").Resize(UBound(vR, 1), UBound(vR, 2)) = vR
End With
et = Timer
Debug.Print "Split time : " & et - st & " seconds"
End Sub