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

Quickest way to modify a recordset and insert into a table

P: n/a
Bob
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

Mar 26 '07 #1
Share this Question
Share on Google+
4 Replies


P: n/a
Hi Bob. Some suggestions.

The Debug.Print statements actually take a surprising amount of time.

Using OpenRecordset on the source and target tables would probably be
quicker than execuing 15k SQL statements.

There might be a way to create a table with records for the values that need
to be found and the replacement values, and then outer join this table to
your original. If you could do something like that (and read the replacement
values rather than using the Replace() function), it might be possible to do
the entire thing in one SQL statement.

--
Allen Browne - Microsoft MVP. Perth, Western Australia
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"Bob" <sc*******@colonialfirststate.com.auwrote in message
news:11*********************@y80g2000hsf.googlegro ups.com...
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
Mar 26 '07 #2

P: n/a
Bob
Hi Allen,

so how would I do that?
Cheers,
Bob


Allen Browne wrote:
Hi Bob. Some suggestions.

The Debug.Print statements actually take a surprising amount of time.

Using OpenRecordset on the source and target tables would probably be
quicker than execuing 15k SQL statements.

There might be a way to create a table with records for the values that need
to be found and the replacement values, and then outer join this table to
your original. If you could do something like that (and read the replacement
values rather than using the Replace() function), it might be possible to do
the entire thing in one SQL statement.

--
Allen Browne - Microsoft MVP. Perth, Western Australia
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"Bob" <sc*******@colonialfirststate.com.auwrote in message
news:11*********************@y80g2000hsf.googlegro ups.com...
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
Mar 26 '07 #3

P: n/a
Bob
Hi Allen,

so how would I do that?
Cheers,
Bob


Allen Browne wrote:
Hi Bob. Some suggestions.

The Debug.Print statements actually take a surprising amount of time.

Using OpenRecordset on the source and target tables would probably be
quicker than execuing 15k SQL statements.

There might be a way to create a table with records for the values that need
to be found and the replacement values, and then outer join this table to
your original. If you could do something like that (and read the replacement
values rather than using the Replace() function), it might be possible to do
the entire thing in one SQL statement.

--
Allen Browne - Microsoft MVP. Perth, Western Australia
Tips for Access users - http://allenbrowne.com/tips.html
Reply to group, rather than allenbrowne at mvps dot org.

"Bob" <sc*******@colonialfirststate.com.auwrote in message
news:11*********************@y80g2000hsf.googlegro ups.com...
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
Mar 26 '07 #4

P: n/a
Bob wrote:
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
It seems like a lot of work is being done that could be trimmed down.

You've transferred the spreadsheet over to a temp table.
You get the first records date data and delete it.
You don't want records where Left(recs.Fields("F1").Value, 3) = "[-]"

The following could be a lookup table
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
I'm going to assume you know how to write a query and use Access's query
builder.

If you know how to create a column in the query builder, you can limit
your records a bit.
NewCol : Left(recs.Fields("F1").Value, 3) = "[-]
This creates a column called NewCol. You can filter that to False.

Check this one out
InvestmentOptionCode : Mid(recs.Fields("F1").Value, 4, 4)
All those parsings can be made into a column.

Your investment options can be linked to a lookup table.

You can also use a function to gather data. I'm going to assume you
know how to write a sub or function. Let's pretend you have a function
called GetOptionCode. You wnat to pass it
NewCol = GetOption([fieldname])
The function should be in a module. Pass the parameters you want/need
and have it return back the value.

If you write a query, you can trim your processing code of each record
to nothing.

Once you have a Select query that filters the data to only the records
you want and you have created the columns you want, create another query
and make it an append query. Then run the append query.

I should think you can cut it down to seconds instead of the minutes you
now experience.

BTW, if you have a query, there's no real need for an append query
because the table is basically a temp table.
Mar 27 '07 #5

This discussion thread is closed

Replies have been disabled for this discussion.