By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,652 Members | 1,995 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,652 IT Pros & Developers. It's quick & easy.

VB code that uses recordset logic and split function runs very slow

P: n/a
Hello, my task is the following:

Input are tables with fields containing strings where the strings are
actually delimited lists. For example, one field could contain
'AB|CD|EF|GH'

I've written code that reads the input table and writes to an output
table with each delimited list parsed out. So if the delimited list
has 4 entries, 4 output records are created, corresponding to the one
input record.

The strategy (algorithm) I've used is to open recordsets in VB and then
use the SPLIT function to parse the field data, and then use the Addnew
and update methods to write the new output records.

My problem is how horribly slow it runs. For example, using an input
record that contains just 3 fields, two them needing to be parsed, it
runs at a speed of about 400 input records per minute, and my computer
is pretty modern fast computer.

If it helps, I've enclose the VB code below. Does anybody have an
idea why it runs so slow or have tips of an alternate algorith to
accomplish what I seek? I haven't been able to think of any other way
to accomplish this.
VB code:

Option Compare Database

Public Function OutputTables() As Boolean
Dim tblName As String, outTblName As String
Dim MainIndex As String
Dim Vname(20) As String, VectorLen As Integer
Dim DataType(20) As String
Dim xStr(20, 30) As String
Const vxxMax = 20
Const VectorLengthMax = 30
Dim vxxHigh As Integer, i As Integer, j As Integer, k As Integer, k2 As
Integer
Dim RecCount As Integer
Dim PrimaryIX As Integer
Dim RS1 As Recordset, RS2 As Recordset, RS3 As Recordset
Dim varArr As Variant
Dim VectorTooBig As Boolean, VectorUneven As Boolean
Dim FieldData As Variant

Set RS1 = CurrentDb.OpenRecordset("qrySpecs")
RS1.MoveFirst

OuterLoop:
tblName = RS1!TableName
MainIndex = RS1!FieldKey
PrimaryIX = RS1!PrimaryID
outTblName = RS1!OutTableName
vxxHigh = 1
DataType(vxxHigh) = RS1!DataType
Vname(vxxHigh) = RS1!VectorFieldName

InnerLoop:
RS1.MoveNext
If RS1.EOF Then
GoSub OutputTable
RS1.Close
MsgBox "Done!"
OutputTables = True
Exit Function
End If
If (RS1!TableName = tblName) And (RS1!PrimaryID = PrimaryIX) Then
vxxHigh = vxxHigh + 1
If vxxHigh > vxxMax Then
MsgBox "More than " + Format(vxxMax) + " vector fields for
table " + tblName + _
", PrimaryID = " + Format(PrimaryIX) + ". Truncation
of fields occuring. " + _
"Suggest upping vxxMax in Visual Basic"
vxxHigh = vxxHigh - 1
Else
Vname(vxxHigh) = RS1!VectorFieldName
DataType(vxxHigh) = RS1!DataType
End If
GoTo InnerLoop
End If
GoSub OutputTable
GoTo OuterLoop

OutputTable:
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE " + outTblName + ".* FROM " + outTblName + ";"
DoCmd.SetWarnings True
Set RS2 = CurrentDb.OpenRecordset(tblName)
Set RS3 = CurrentDb.OpenRecordset(outTblName)
VectorTooBig = False
VectorUneven = False
RS2.MoveFirst
RecCount = 1
Do While Not RS2.EOF
For i = 1 To vxxHigh
FieldData = RS2(Vname(i))
If IsNull(FieldData) Then
k2 = 0
Else
varArr = Split(FieldData, "|")
k = UBound(varArr)
k2 = -1
For j = k To 0 Step -1
If varArr(j) <> "" Then
k2 = j
Exit For
End If
Next j
k2 = k2 + 1
End If
If k2 > VectorLengthMax Then
VectorTooBig = True
k2 = VectorLengthMax
End If
If i = 1 Then
VectorLen = k2
Else
If k2 <> VectorLen Then
VectorUneven = True
End If
End If
For j = 0 To VectorLen - 1
xStr(i, j + 1) = varArr(j)
Next j
Next i
For k = 1 To VectorLen
RS3.AddNew
RS3(MainIndex) = RS2(MainIndex)
For i = 1 To vxxHigh
If DataType(i) = "T" Then
RS3(Vname(i)) = xStr(i, k)
Else
RS3(Vname(i)) = Val(xStr(i, k))
End If
Next i
RS3.Update
Next k
RS2.MoveNext
RecCount = RecCount + 1
If RecCount Mod 100 = 0 Then
Debug.Print "table=" + tblName + ", count=" +
Format(RecCount)
End If
Loop
RS2.Close
RS3.Close
If VectorTooBig Then
MsgBox "Warning. Table " + tblName + " had at least one vector
that exceeded the " + _
"maximum allowable size of " + Format(VectorLengthMax) + ".
Suggest modifying the VB code"
End If
If VectorUneven Then
MsgBox "Warning. Table " + tblName + " had at least one record
containing multiple vectors " + _
"of uneven length"
End If
Return
End Function

Nov 13 '05 #1
Share this Question
Share on Google+
2 Replies


P: n/a
Sorry for the false alarm. It turns out I was running this code on a
network. When I run it on my PC it's really fast. The input table as
1300 record, and it seems like the whole thing ran in a second, which
almost 200 times faster than on the network. So this is my
workaround... I'll run it locally. I'd still be interested to find
out why network speeds are so much slower.

Nov 13 '05 #2

P: n/a
The network speed is slower because the network is slower than your hard
drive IO. Also, if others are using the file, that will slow things down
even more. Something that may help would be to wrap the whole thing in a
transaction so that you can make one write to the table across the network
when you are done.

Also, I recommend that you use & instead of + for string concatenation. +
will work as an operator if the value can be interpreted as a number or
Null. This may give undesirable results. If dealing strictly with string
data, this isn't a problem. But, since VBA will auto convert data for you,
if it thinks the value may be a number it may convert it to a number and
cause you problems. There are times that using + is advantageous
(particularly when concatenating with a Null value), I just don't recommend
it as the normal way to concatenate.

--
Wayne Morgan
MS Access MVP
"ThurstonHowl" <ti****************@yahoo.com> wrote in message
news:11*********************@g49g2000cwa.googlegro ups.com...
Sorry for the false alarm. It turns out I was running this code on a
network. When I run it on my PC it's really fast. The input table as
1300 record, and it seems like the whole thing ran in a second, which
almost 200 times faster than on the network. So this is my
workaround... I'll run it locally. I'd still be interested to find
out why network speeds are so much slower.

Nov 13 '05 #3

This discussion thread is closed

Replies have been disabled for this discussion.