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