Hi all,

I'm trying to import data, modify the data then insert it into a new
table.  The code below works fine for it but it takes a really long
time for 15,000 odd records.  Is there a way I can speed up the
processing substantially? as it currently takes about 10 minutes and
thats just way too long because there is many of these imports that I
need to do.... I currently insert each record one by one and I
imagine
thats where all the processing power is going, running 15,000 SQL
statements, is there a way to put it into an array or another
recordset and speed it up that way etc? any ideas?  please let me
know
what code I would need.. see my code below as a starting point...
cheers, Bob.

Private Sub LblMenu1Sub1Lbl1_Click()

Dim strFilter As String
Dim strInputFileName As String
Dim State As String
Dim TableName As String
Dim strSQL1 As String
Dim strSQL2 As String
Dim db As DAO.Database
Dim recs As DAO.Recordset
Dim RecordStr As String
Dim GetDate As String
Dim FinalDate As Date
Dim Field1 As String
Dim Field2 As String
Dim Field3 As String
Dim Field4 As String
Dim Field5 As String
Dim Field6 As String
Dim Field7 As String
Dim Field8 As String
Dim Field9 As String
Dim InvestmentGroup As String
Dim InvestmentGroupCode As String
Dim InvestmentOption As String
Dim InvestmentOptionCode As String
Dim DealerGroup As String
Dim DG As String
Dim DealerGroupCode As String
Dim Inflow As Double
Dim Outflow As Double
Dim Netflow As Double
Dim tdfNew As TableDef
Dim prpLoop As Property
Dim RecCount As Integer

DoCmd.SetWarnings (False)

Set db = CurrentDb()

State = "NSW"
TableName = State & " temp"

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)",
"*.XLS")
strInputFileName = ahtCommonFileOpenSave( _
               Filter:=strFilter, OpenFile:=True, _
               DialogTitle:="Select NSW Spreadsheet file ...", _
               Flags:=ahtOFN_HIDEREADONLY)

If TableExists(TableName) = True Then
   DoCmd.RunSQL ("drop table [" & TableName & "];")
End If

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9,
TableName, strInputFileName, 0

'Create new Table
If TableExists(State) = True Then
   DoCmd.RunSQL ("drop table [" & State & "];")
End If

'Rename Fields
Field1 = "Investment Group Code"
Field2 = "Investment Group"
Field3 = "Investment Option Code"
Field4 = "Investment Option"
Field5 = "Dealer Code"
Field6 = "Dealer Group"
Field7 = "Inflow"
Field8 = "Outflow"
Field9 = "Netflow"

Set tdfNew = db.CreateTableDef(State)

With tdfNew

   .Fields.Append .CreateField(Field1, dbText)
   .Fields.Append .CreateField(Field2, dbText)
   .Fields.Append .CreateField(Field3, dbText)
   .Fields.Append .CreateField(Field4, dbText)
   .Fields.Append .CreateField(Field5, dbText)
   .Fields.Append .CreateField(Field6, dbText)
   .Fields.Append .CreateField(Field7, dbCurrency)
   .Fields.Append .CreateField(Field8, dbCurrency)
   .Fields.Append .CreateField(Field9, dbCurrency)

   db.TableDefs.Append tdfNew

   Set tdfNew = Nothing

End With

'Begin Cleanup of Temp data

'Remove junk header rows
strSQL1 = "DELETE [" & TableName & "].F4 FROM [" & TableName & "]
WHERE ((([" & TableName & "].F4) Is Null)) OR ((([" & TableName &
"].F4)='   Outflow'));"
DoCmd.RunSQL (strSQL1)

RecordStr = "select * FROM [" & TableName & "];"
Set recs = db.OpenRecordset(RecordStr)

recs.MoveFirst

GetDate = Trim(recs.Fields("F3").Value)
FinalDate = DateValue(GetDate)

recs.Delete

recs.MoveNext

Do While recs.EOF = False

   'Test for Investment Group and do not write to new table if true
   If Left(recs.Fields("F1").Value, 3) = "[-]" Then
       InvestmentGroupCode = Mid(recs.Fields("F1").Value, 4, 4)
       InvestmentGroup = Right(recs.Fields("F1").Value,
Len(recs.Fields("F1").Value) - 10)

   Else
       InvestmentOptionCode = Mid(recs.Fields("F1").Value, 4, 4)
       InvestmentOption = Right(recs.Fields("F1").Value,
Len(recs.Fields("F1").Value) - 10)

       Select Case InvestmentOption
           Case "Cred Suisse Int'l Sh"
               InvestmentOption = "Cred Suisse Int Sh"
           Case "Platinum Int'l"
               InvestmentOption = "Platinum Int"
           Case "Perpetual Int'l"
               InvestmentOption = "Perpetual Int"
       End Select

       DealerGroupCode = Right(recs.Fields("F2").Value, 4)
       DG = Mid(recs.Fields("F2").Value, 4,
Len(recs.Fields("F2").Value) - 10)

       If InStr(DG, "'") <> 0 Then
           DealerGroup = Replace(DG, "'", "")
       Else
           DealerGroup = DG
       End If

           'Test for NULL Inflow & Outflow Values
           If recs.Fields("F3").Value = "NULL" Then
               Inflow = Format(0, "Currency")
           Else
               Inflow = Format(recs.Fields("F3").Value, "Currency")
           End If

           If recs.Fields("F4").Value = "NULL" Then
               Outflow = Format(0, "Currency")
           Else
               Outflow = Format(recs.Fields("F4").Value, "Currency")
           End If

       Netflow = Format(Inflow - Outflow, "Currency")

       Debug.Print "[NEXT]"
       Debug.Print "Investment Group Code: [" & InvestmentGroupCode
&
"]"
       Debug.Print "Investment Group: [" & InvestmentGroup & "]"
       Debug.Print "Investment Option Code: [" &
InvestmentOptionCode
& "]"
       Debug.Print "Investment Option: [" & InvestmentOption & "]"
       Debug.Print "DealerGroupCode: [" & DealerGroupCode & "]"
       Debug.Print "DealerGroup: [" & DealerGroup & "]"
       Debug.Print "Inflow: [" & Inflow & "]"
       Debug.Print "Outflow: [" & Outflow & "]"
       Debug.Print "Netflow: [" & Netflow & "]"

       strSQL2 = "INSERT INTO " & State & " ([Investment Group
Code],
[Investment Group], [Investment Option Code]," & _
       " [Investment Option], [Dealer Code], [Dealer Group],
[Inflow], [Outflow], [Netflow])" & _
       " SELECT '" & InvestmentGroupCode & "', '" & InvestmentGroup
&
"', '" & InvestmentOptionCode & "', '" & InvestmentOption & "', '" &
_
       DealerGroupCode & "', '" & DealerGroup & "', " & Inflow & ",
"
& Outflow & ", " & Netflow & ";"

       DoCmd.RunSQL (strSQL2)

   End If

   recs.MoveNext

Loop

Set recs = Nothing
Set db = Nothing

DoCmd.SetWarnings (True)

End Sub