slo-o-w code

[JimMuglia]

Say, my program is taking kind of long too run, mostly becasue of the size of the files being extracted. Still, the customer needs it to be quicker.

The code for sending the extracted items to the database is below. Does anyone see anything I can do to speed up the process. I realize its long and convoluted; but if anyone sees anything at first glance that I can do to speed thngs up, please let me know. Its a big section, so I'll break it in pieces. I really apprecaite it.

Sub SendToDatabase()
Dim rst As New ADODB.Recordset
Dim cmd As ADODB.Command
Dim dbAdd As Boolean
Dim reopenRecordset As Boolean
Dim sql As String
Dim Characteristic As String
Dim n As Integer
Dim x As Long
'On Error GoTo stdhandler
tr = 1
'subgroupitemcount = 0
'On Error Resume Next
dbAdd = True
pbimport.Enabled = True
'On Error GoTo handler
reopenRecordset = True
'Create a connection object.
Set cnn = CreateObject("ADODB.Connection")
 
'Open a Microsoft Access database connection using the OLE DB connection string.
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= " & Trim(lbldatabase.Caption)
 
'Open a Microsoft SQL Server Connection
'Provider=SQLOLEDB.1;Data Source=path to server
 
'***save assigned data into the appropriate database***
 
'for each line of the code
For x = 1 To xcount
 
'PART NAME
 
' First, check to see if the part already exists, by getting all partnames
' and seeing if any of them are the same as the variable 'partname'
'temppartname = partname
'temppartname = Replace(temppartname, "&", "and")
temppartname = part(x)
temppartname = Replace(temppartname, "&", "and")
temppartname = Replace(temppartname, "#", "")
temppartname = Replace(temppartname, Chr$(34), "")
sourcesqlstatement = "Select PartName from Part where PartName <> ''"
rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
If rst.RecordCount > 0 Then
    rst.MoveFirst
    Do While Not rst.EOF
        Value = rst.Fields("PartName")
        If Value = temppartname Then
            dbAdd = False
            Exit Do
         End If
        rst.MoveNext
    Loop
End If
rst.Close
 
'Secondly, put the part into database, if necessary.
    If dbAdd Then
        lasteditdate = Now
 
        sql = "INSERT INTO Part (PartName, LastEditDate, GroupId) VALUES ('" & temppartname & "', '" & lasteditdate & "',-1)"
       
        cnn.Execute sql
    End If
    dbAdd = True
 
'Thirdly, assign the id value for the part to a variable, so that it can be put in the characteristic table, if necessary.
sourcesqlstatement = "Select PartId From Part Where PartName = '" & temppartname & "'"
rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
    If rst.RecordCount > 0 Then
        rst.MoveFirst
        dbAdd = True
        Do While Not rst.EOF
            partid = rst.Fields("PartId")
            rst.MoveNext
        Loop
    End If
    rst.Close
 
'TRACE
' First, check to see if the trace name alreday exists, by getting all trace names
' and seeing if any of them are the same as the variable 'tracename'
For t = 1 To tracecount
sourcesqlstatement = "Select TraceId, TraceName from Trace where TraceName <> ''"
rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
dbAdd = True
If rst.RecordCount > 0 Then
    rst.MoveFirst
    Do While Not rst.EOF
        traceid(t) = rst.Fields("TraceId")
        Value = rst.Fields("TraceName")
        If Trim(UCase(Value)) = Trim(UCase(tracename(t))) Then
            dbAdd = False
            reopenRecordset = False
            Exit Do
         End If
        rst.MoveNext
    Loop
End If
rst.Close
 
'Second, add any new trace name to the trace table.
If dbAdd Then 'add trace name to Trace table if it doesn't already exist
    sql = ""
    temptracename = tracename(t)
    temptracename = Replace(temptracename, "&", "and")
    temptracename = Replace(temptracename, "#", "")
    temptracename = Replace(temptracename, Chr$(34), "")
    sql = "INSERT INTO Trace (TraceName, LastEditDate, GroupId, IsACCA, StoreTraceCodes) VALUES ('" & temptracename & "', '" & Now & "',-1,0,0)"
    cnn.Execute sql
End If
latesttracename = tracename(t)
 
'Thirdly, reopen the Trace table recordset, and extract the traceid of the latest
'trace name inserted, so that it can be inserted into TraceCodes and Data tables
If reopenRecordset Then
    sourcesqlstatement = "Select TraceId, TraceName from Trace where TraceName <> ''"
    rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
    dbAdd = True
    If rst.RecordCount > 0 Then
        rst.MoveFirst
        Do While Not rst.EOF
            Value = rst.Fields("TraceName")
            If Trim(UCase(latesttracename)) = Trim(UCase(Value)) Then
                traceid(t) = rst.Fields("TraceId") 'save these to check for adding trace codes later
                'tr = tr + 1
                Exit Do
            End If
            rst.MoveNext
        Loop
    End If
    rst.Close
End If
Next t

[JimMuglia]

'CHARACTERISTIC
    'Firstly, check to see if the characteristic already exists, a characteristic being
    'a matching Charname and PartId combo within the Characteristic table.
    dbAdd = True
    charname(x) = Replace(charname(x), "&", "and")
    charname(x) = Replace(charname(x), "#", "")
    charname(x) = Replace(charname(x), Chr$(34), "")
    sourcesqlstatement = "Select CharId, PartId, CharName from Characteristic where PartId = " & partid & " And CharName = '" & charname(x) & "'"
    rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
    If rst.RecordCount > 0 Then
        rst.MoveFirst
        Do While Not rst.EOF
            dbAdd = False
            vcharid = rst.Fields("CharId")
            Exit Do
            rst.MoveNext
        Loop
    End If
    rst.Close
 
    If dbAdd Then 'If the characteristic does not exist in the table, then
        ' add a new record to the characteristic table
        sql = "INSERT INTO Characteristic (PartId, CharName, LastEditDate, Target, USL, LSL, CharDataId, SubgroupSize, DecimalPlaces, ChartType, ShowHistogram, ShowLSL, ShowUSL, ShowTarget, ShowControlChart, IsRainbow, ValidateEntry, CurveFit, ValidateUpper, ValidateLower, ValidateRatio, ValidateSampleSize, BatchSize, BatchType, PlotLastCount, PlotLastType) VALUES (" & partid & ", '" & charname(x) & "', '" & Now & "', '" & target(x) & "', '" & USL(x) & "', '" & LSL(x) & "',0, '" & subgroupsize & "', 6, 3, 0, 1, 1, 1, 1, -1, 1, 1, 2.225074E-308, 2.225074E-308, 2.225074E-308, 0, 0, 0, 0, 0)"
        cnn.Execute sql
    Else 'If the characteristic does exist in the table, then
        'just update the target, USL, and LSL of the existing record
        sql = "UPDATE Characteristic SET Target = " & target(x) & ", " & "USL = " & USL(x) & ", " & "LSL = " & LSL(x) & " where CharId = " & vcharid
        cnn.Execute sql
        DoEvents
    End If
    dbAdd = True
 
'TRACE CODES
'Firstly, open TraceCode table and check to ensure that no
'duplicate TraceCodeName and TraceId combos are inserted for each tracevalue(t, x)
 
For t = 1 To tracecount
    whileflag = 1
    dbAdd = True
    If whileflag = 1 Then
        sourcesqlstatement = "Select TraceId, TraceCodeName from TraceCodes where TraceCodeName <> ''"
        rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
        If rst.RecordCount > 0 Then
            rst.MoveFirst
            Do While Not rst.EOF
                Value = rst.Fields("TraceCodeName")
                tid = rst.Fields("TraceId")
                If tid = traceid(t) And (Trim(UCase(Value)) = Trim(UCase(operator(x))) Or Trim(UCase(Value)) = Trim(UCase(serialnumber(x))) Or Trim(UCase(Value)) = Trim(UCase(trial(x))) Or Trim(UCase(Value)) = Trim(UCase(cam(x))) Or Trim(UCase(Value)) = Trim(UCase(check(x))) Or Trim(UCase(Value)) = Trim(UCase(grinder(x)))) Then
                    dbAdd = False
                    Exit Do
                End If
                rst.MoveNext
            Loop
            rst.Close
        End If
        
        Select Case t
            Case 1
                'insert OPERATOR
                tracevalue(t, x) = operator(x)
                If Len(operator(x)) > 0 And dbAdd = True Then
                    sql = "INSERT INTO TraceCodes (TraceId, TraceCodeName, ActiveStatus) VALUES ('" & traceid(t) & "', '" & operator(x) & "', 0)"
                    cnn.Execute sql
                End If
            
            Case 2
                tracevalue(t, x) = serialnumber(x)
                'insert SERIALNUMBER
                If Len(serialnumber(x)) > 0 And dbAdd = True Then
                    sql = "INSERT INTO TraceCodes (TraceId, TraceCodeName, ActiveStatus) VALUES ('" & traceid(t) & "', '" & serialnumber(x) & "', 0)"
                    cnn.Execute sql
                End If
        
            Case 3
                tracevalue(t, x) = trial(x)
                'insert TRIAL
                If Len(trial(x)) > 0 And dbAdd = True Then
                    sql = "INSERT INTO TraceCodes (TraceId, TraceCodeName, ActiveStatus) VALUES ('" & traceid(t) & "', '" & trial(x) & "', 0)"
                    cnn.Execute sql
                End If
        
            Case 4
                tracevalue(t, x) = cam(x)
                'insert CAM
                If Len(cam(x)) > 0 And dbAdd = True Then
                    sql = "INSERT INTO TraceCodes (TraceId, TraceCodeName, ActiveStatus) VALUES ('" & traceid(t) & "', '" & cam(x) & "', 0)"
                    cnn.Execute sql
                End If
        
            Case 5
                tracevalue(t, x) = check(x)
                'insert CHECK
                If Len(check(x)) > 0 And dbAdd = True Then
                    sql = "INSERT INTO TraceCodes (TraceId, TraceCodeName, ActiveStatus) VALUES ('" & traceid(t) & "', '" & check(x) & "', 0)"
                    cnn.Execute sql
                End If
        
            Case 6
                tracevalue(t, x) = grinder(x)
                'insert GRINDER
                If Len(grinder(x)) > 0 And dbAdd = True Then
                    sql = "INSERT INTO TraceCodes (TraceId, TraceCodeName, ActiveStatus) VALUES ('" & traceid(t) & "', '" & grinder(x) & "', 0)"
                    cnn.Execute sql
                End If
        End Select
    End If
    DoEvents
Next t
 
'DATA
    'First, get the last DataId in the present Data table, to later determine where the new
    'data was inserted in the table. It will serve as
    'an indication of where to start inserting the SubgroupLock values.
    'The last DataId value will be asssigned to the variable lastDataId. This will assist in
    'determining the SubgroupLockNumber and SubroupItem number.
    sourcesqlstatement = "Select DataId From Data"
    rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
    If rst.RecordCount > 0 Then
        rst.MoveLast
        Do While Not rst.EOF
            lastDataId = rst.Fields("DataId")
            Exit Do
        Loop
    Else
        lastDataId = 1 'jrm 5/15/2003
    End If
    rst.Close
 
    'Secondly, obtain the proper partid
    sourcesqlstatement = "Select PartId From Part Where PartName = '" & temppartname & "'"
    rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
    rst.MoveFirst
    dbAdd = True
    Do While Not rst.EOF
        partid = rst.Fields("PartId")
        rst.MoveNext
    Loop
    rst.Close
 
    'Thirdly, obtain the CharId and the SubgroupSize, based on CharName and the PartId
    sourcesqlstatement = "Select CharId, SubgroupSize From Characteristic Where PartId = " & partid & " And CharName = '" & charname(x) & "'"
    rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
    If rst.RecordCount > 0 Then
        rst.MoveFirst
        dbAdd = True
        Do While Not rst.EOF
            Charid = rst.Fields("CharId")
            subgroupsize = rst.Fields("SubgroupSize")
            'subgroupItemNumber = n Mod subgroupsize
            rst.MoveNext
        Loop
    End If
    rst.Close
 
    'Fourthly, insert the data into the database
    ddatetime(x) = Replace(ddatetime(x), Chr$(34), "")
    sql1 = "INSERT INTO Data (CharId, [Value], [DateTime]"
    sql2 = ") VALUES (" & Charid & ", " & dvalue(x) & ", '" & ddatetime(x) & "'"
        
    'add necessary trace info to the insert query
    For Y = 1 To tracecount
        temptracevalueY = Replace(tracevalue(Y, x), "&", "and")
        temptracevalueY = Replace(temptracevalueY, Chr$(34), "")
        temptracevalueY = Replace(temptracevalueY, "#", "")
        sql1 = sql1 & ", Trace" & Y & ", TraceId" & Y
        sql2 = sql2 & ", '" & temptracevalueY & "', " & traceid(Y)
    Next Y
    sql2 = sql2 & ")"
    sql = sql1 & sql2
    cnn.Execute sql
        
    'Fifthly, open the newest data record that contained the same CharId, and insert the appropriate Subgroup Item number, as well as the appropriate SubgroupLock value
    sourcesqlstatement = "Select DataId, CharId, SubgroupItem, SubgroupLock From Data Where CharId = " & Charid & " And DataId > " & lastDataId & " ORDER BY DataId"
    rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
    SubgroupItem = 0
    rc = rst.RecordCount
    If rc > 0 Then
    rst.MoveFirst
    rst.MoveLast
    Do While Not rst.EOF
        rst!SubgroupLock = rst!DataId
        rst!SubgroupItem = 0
        Exit Do
    Loop
    rst.MoveFirst
    rst.Close
    End If
    
    'display to the user where the program is at
    pbimport.Min = 0
    pbimport.Max = fc
    DoEvents
    Label5.Caption = "Total number of directories being imported: " & dircount & "; Presently on directory: " & presentdir & ";" & Chr(13) & "Total number of files in present directory: " & fc & "; Presently on file: " & partcount & ";" & Chr(13) & "Present directory: " & directory & ";" & Chr(13) & "Present file name: " & file(UBound(file)) & ";" & Chr(13) & "Present part name: " & temppartname & ";" & Chr(13) & "Number of data items in present file: " & xcount & " Presently on data item: " & x & "."
    pbimport.Value = partcount
 
Next x
 
cnn.Close
Exit Sub
End Sub

[Madboy]

It may be better to attach a project, or use the vbCode tags - easier to read then

[JimMuglia]

Thanks for the tip. Sorry about that.

Well, for instance, consider the query below:

sourcesqlstatement = "Select DataId, CharId, SubgroupItem, SubgroupLock From Data Where CharId = " & Charid & " And DataId > " & lastDataId & " ORDER BY DataId"

What I'm doing is keeping track of the very lastly saved DataId to use as a standard for determining the next one.

Is there some command that would just go and get the maximum DataId value, and maybe save some time, and not necesarily go through all bazillion data records to see if each is greater than the last id?

Put another way, is there any way to start the search at the last data id rather than at the first?

I'm figuring that for one, may save some time. So, any ideas for maximinzing the speed of the qeury above?

Thank you,
Jim

[MartinLiss]

Originally posted by JimMuglia
Thanks for the tip. Sorry about that...

You can always go back and Edit them in, like I just did.

[JimMuglia]

Thank you for that, and sorry for not seeing your signature earlier.
So... any answers out there?

Thank you,
Jim

[MartinLiss]

I believe there are code analyzers that will show you where you are spending your execution time. You/your company might want to invest in one.

[JimMuglia]

Originally posted by MartinLiss
I believe there are code analyzers that will show you where you are spending your execution time. You/your company might want to invest in one.

Hmm, are there any websites with free downloads out there, that you know of?

[MartinLiss]

I don't know about free, but try Google.

[szlamany]

As for getting the max value

"SELECT MAX(columnname) FROM TABLE WHERE..." - will do just that...

Do you have indexes on the columns that are being used in WHERE clauses (we do MS SQL 2000 here - not ACCESS, I'm not sure of what the differences are).

Does ACCESS have provisions for STORED PROCEDURES?

[Shawn N]

I see some room for improvement. For example, in the beginning of your procedure where you're loading "tempname" you could turn tempname into an array, load all your part name's into that array, and load all your partname's (as you're already doing) into rst.

Then you could use 2 nested for/next loops to iterate through the array and recordset.

You'd probably get a little more help if you actually posted your project.

[JimMuglia]

I really appreciate everyone's input.

Hmmm, I think I'll have to do the array idea at least for the characteristics, as there are several records in that, which must be searched by two PK fields: PartId and CharName. I really think that's what's making the program go like molasses. That's gottabe what's bogging it down.

One other qeustion, would doing an insert this way save any time, or is it just prettier than the "insert into trace..." style?

With rst
.AddNew
!tracename = temptracename
!lasteditdate = Now
!LastEdit = "SPC AutoCollector"
!GroupID = -1
!ISAccA = 0
!StoreTraceCodes = 0
!ActiveStatus = 0
!Persistent = 0
.Update
.Close
End With

[leinad31]

This would be easier if the project and the database (just some smple data) where attached.

You have part() right? Instead of looping through that and checking each if it already exists in the database for adding, I would create a query that would return all records not in part(). Then iterate through those... hopefully less iterations.

Something like the inverse of...

Private Function Build_ShapeCommand() As String
 
Dim strWHERE_Supplier() As String
Dim strWHERE_TestMat() As String
Dim strWHERE_Subtest() As String
Dim strWHERE_Misc() As String
 
   strWHERE_Misc = Build_WHERE_Misc
   strWHERE_Subtest = Build_WHERE_Subtest
   strWHERE_Supplier = Build_WHERE_Supplier
   strWHERE_TestMat = Build_WHERE_TestMaterial
 
   strWHERE = "WHERE (1 = 1) "
   strWHERE = strWHERE & IIf(strWHERE_Misc(UBound(strWHERE_Misc)) <> "", "AND " & Join(strWHERE_Misc, " AND ") & " ", "")
   strWHERE = strWHERE & IIf(strWHERE_Subtest(UBound(strWHERE_Subtest)) <> "", "AND (" & Join(strWHERE_Subtest, " OR ") & ") ", "")
   strWHERE = strWHERE & IIf(strWHERE_Supplier(UBound(strWHERE_Supplier)) <> "", "AND (" & Join(strWHERE_Supplier, " OR ") & ") ", "")
   strWHERE = strWHERE & IIf(strWHERE_TestMat(UBound(strWHERE_TestMat)) <> "", "AND (" & Join(strWHERE_TestMat, " OR ") & ") ", "")
   strWHERE = strWHERE & " "
 
'blah 
'blah
End Sub
 
Private Function Build_WHERE_Subtest() As String()
Dim strWHERE() As String
Dim lngIterate As Long
 
   ReDim strWHERE(0)
   Build_WHERE_Subtest = strWHERE   'init value
   
   'Check for CheckAll and CheckNone conditions
   If chkSubTest.Value = vbUnchecked Then Exit Function 'Unfiltered
   If (lvwSubtest.ListItems.Count > 0) And (cmdSubtestChkAll.Enabled = False) Then
      Exit Function  'return all
   ElseIf (lvwSupplier.ListItems.Count > 0) And (cmdSubtestChkNone.Enabled = False) Then
      strWHERE(0) = "([PO Details].[Subtest ID] = '')"   'return none
   Else
      '(F = x) or (F = y) or..., create (F = ) condition if checked
      For lngIterate = 1 To lvwSubtest.ListItems.Count
         If lvwSubtest.ListItems(lngIterate).Checked = True Then
            If strWHERE(UBound(strWHERE)) <> "" Then ReDim Preserve strWHERE(UBound(strWHERE) + 1)
            strWHERE(UBound(strWHERE)) = "([PO Details].[Subtest ID] = '" & lvwSubtest.ListItems(lngIterate).Text & "') "
         End If
      Next
   End If
   
   If strWHERE(UBound(strWHERE)) = "" And UBound(strWHERE) > 0 Then
      ReDim Preserve strWHERE(UBound(strWHERE) - 1)  'Delete appending blank if any
   End If
   
   Build_WHERE_Subtest = strWHERE
End Function

[JimMuglia]

Originally posted by leinad31
This would be easier if the project and the database (just some smple data) where attached.

I really appreciate the desire to see the whole program; and I'd send all of that in a heartbeat if my boss would let me.

Well, if we can at least get me set up with making this quicker, that would be where I need to go anyways. I'll test things out here; if anyone has any modifcations to speed this CHARACTERISTIC portion up, please let me know. It sure is slowing things down.

'CHARACTERISTIC
    'Firstly, check to see if the characteristic already exists, a characteristic being
    'a matching Charname and PartId combo within the Characteristic table.
    dbAdd = True
    charname(x) = Replace(charname(x), "&", "and")
    charname(x) = Replace(charname(x), "#", "")
    charname(x) = Replace(charname(x), Chr$(34), "")
    sourcesqlstatement = "Select CharId, PartId, CharName from Characteristic where PartId = " & partid & " And CharName = '" & charname(x) & "'"
    rst.Open sourcesqlstatement, cnn, adOpenStatic, adLockOptimistic
    If rst.RecordCount > 0 Then
        rst.MoveFirst
        Do While Not rst.EOF
            dbAdd = False
            vcharid = rst.Fields("CharId")
            Exit Do
            rst.MoveNext
        Loop
    End If
    rst.Close
 
    If dbAdd Then 'If the characteristic does not exist in the table, then
        ' add a new record to the characteristic table
        sql = "INSERT INTO Characteristic (PartId, CharName, LastEditDate, Target, USL, LSL, CharDataId, SubgroupSize, DecimalPlaces, ChartType, ShowHistogram, ShowLSL, ShowUSL, ShowTarget, ShowControlChart, IsRainbow, ValidateEntry, CurveFit, ValidateUpper, ValidateLower, ValidateRatio, ValidateSampleSize, BatchSize, BatchType, PlotLastCount, PlotLastType) VALUES (" & partid & ", '" & charname(x) & "', '" & Now & "', '" & target(x) & "', '" & USL(x) & "', '" & LSL(x) & "',0, '" & subgroupsize & "', 6, 3, 0, 1, 1, 1, 1, -1, 1, 1, 2.225074E-308, 2.225074E-308, 2.225074E-308, 0, 0, 0, 0, 0)"
        cnn.Execute sql
    Else 'If the characteristic does exist in the table, then
        'just update the target, USL, and LSL of the existing record
        sql = "UPDATE Characteristic SET Target = " & target(x) & ", " & "USL = " & USL(x) & ", " & "LSL = " & LSL(x) & " where CharId = " & vcharid
        cnn.Execute sql
        DoEvents
    End If
    dbAdd = True

[JimMuglia]

Well, I got the code to go a lot faster with some tinkering and some help.

Now I am interested in this question:

Would the program be even faster if they were using a SQLServer database, instead of an Access database?

Or would it not make a difference?

I know SQLServer is good for larger quantities of data; but would it any way effect the speed of my program?

Thank you,
Jim

[szlamany]

SQL is designed for true client server application. This means that you have a different processor running the queries. You would want to stop building "query strings" in VB and executing those commands and instead develop stored procedures on the server - passing parameters with ADO from VB to these procedures. They are pre-compiled and optimized - run much faster.

MSDE is a version of SQL that runs on a standalone workstation with the client code (it is just the data engine).

Visit this website and post your question to them...

http://www.microsoft.com/sql/communi...lserver.server