Hi Bob,
Here's an *idea*...
1.) Create a properly structured "Template" table with an AutoNumber field,
correct field names / data types ...etc.
2.) Make a copy of the "template" table, renaming it to the "good" table
that you want to use for your forms and reports, etc.
3.) Design an append query that filters out the junk, and appends the good
data.
4.) When it comes time to refresh the data from a new import file ... delete
your "good" table, make a new copy of the "template" (as in step 2 above)
Here's a code sample (long) that will hopefully explain how I have automated
the entire import process.
What used to take an hour to do now takes just seconds, so this strategy
will be worth the time investment (IMHO)
This code also calls a couple of custom functions and subs that I have
designed, but not included. Many of the variable are declared in the form
declaration section as they are used by multiple procedures.
If you're REALLY interested, let me know ... and I'll post (or e-mail) them
as well.
Private Sub cmdImport086_Click()
On Error GoTo cmdImport086_Err
'======================== Step 1 ==========================
'==================== Test Data Path ======================
MyPath = Me.txtDataPath
Me![txtProgress].Visible = True
Me![txtProgress].SetFocus
Me![txtProgress].Text = "Testing Data Path"
Me.Refresh
DoCmd.Beep
Me![txtProgress].SelStart = 0
Wait 2, False
TestDataPath 'Call Sub
'======================== Step 2 ==========================
'=============== User FileName Confirmation ===============
CR = vbCrLf
Msg = ""
Msg = Msg & "You are about to import data from: " & CR
Msg = Msg & MyPath & CR
Msg = Msg & "Press 'Yes' if this is correct or 'No' to set Data Path"
If MsgBox(Msg, vbYesNo, "Check Data Path!") = vbNo Then
Me.Dirty = False
Me![txtProgress].SelStart = 0
Wait 2, False
FindPF
End If
'======================== Step 3 ==========================
'===================== Safety Check =======================
' Filename MUST be "RPT086" or program exits
Me![txtProgress].Text = "Checking File Name"
Me.Refresh
DoCmd.Beep
Me![txtProgress].SelStart = 0
Wait 2, False
If InStr(1, MyPath, "RPT086", vbTextCompare) Then GoTo Step4
Msg = ""
Msg = Msg & "You are attempting to import the wrong file!" & CR
Msg = Msg & "Please click on the 'Set / Verify Data Path'" & CR
Msg = Msg & "button to attempt to find it," & CR
Msg = Msg & "OR follow steps 1 & 2 to recreate it. "
MsgBox (Msg)
Me![cmdSetDataPath].SetFocus
Exit Sub
Step4:
'======================== Step 4 ==========================
'==================== Import RPT086.PF ====================
Me![txtProgress].Text = "Deleting / recreating import table "
Me.Refresh
DoCmd.Beep
Me![txtProgress].SelStart = 0
Wait 2, False
'Delete the old table...
If IsTableQuery("", "RPT086") Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, "RPT086"
DoCmd.SetWarnings True
End If
'Copy the blank(template)table, renaming it to "RPT086"
DoCmd.CopyObject , "RPT086", acTable, "RPT086Template"
'Now that we have correctly structured table (with ID, Line1, Line2)
'we can import the data.
Me![txtProgress].Text = "Importing TAMS report"
Me.Refresh
DoCmd.Beep
Me![txtProgress].SelStart = 0
Wait 2, False
DoCmd.TransferText acImportFixed, "RPT086 Import Specification", "RPT086",
MyPath, False, ""
'Delete the ImportErrors table if it exists. (It shouldn't.. and I don't
need it.)
If IsTableQuery("", "RPT086_ImportErrors") Then
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, "RPT086_ImportErrors"
DoCmd.SetWarnings True
End If
'======================== Step 5/6 ==========================
'==================== Find / Fill Line Codes ================
' Purpose: To first find and record the first instance of each
' "Product Line", then fill that value down for a range of records.
' Open, populate,and get the recordcount from the recordset.
Me![txtProgress].Text = "Finding product line codes."
Me.Refresh
DoCmd.Beep
Me![txtProgress].SelStart = 0
Wait 2, False
MySQL = "" 'Initialize String to nothing.
MySQL = MySQL & "SELECT StripSpaces([PartNumber1] & [PerCar1] & [Retail1])
AS "
MySQL = MySQL & "ProductLine, Mid(Trim([ProductLine]),13,3) AS ProdLine,
RPT086.ID "
MySQL = MySQL & "FROM RPT086 "
MySQL = MySQL & "WHERE (((StripSpaces([PartNumber1] & [PerCar1] &
[Retail1])) Like '*' "
MySQL = MySQL & "& "
MySQL = MySQL & Chr$(34) & "ProductLine"
MySQL = MySQL & Chr$(34) & " & '*')) "
MySQL = MySQL & "ORDER BY RPT086.ID;"
'Debug.Print MySQL
'*************************** FILL IN LINE CODES ***************************
Me![txtProgress].Text = "Adding line codes to all records."
Me.Refresh
DoCmd.Beep
Me![txtProgress].SelStart = 0
Wait 2, False
Set MyDB = CurrentDb
Dim rstLines As Recordset
Set rstLines = MyDB.OpenRecordset(MySQL)
With rstLines
.MoveLast
.MoveFirst
MyRecCount = .RecordCount
For intI = 1 To MyRecCount
MyLine = !Prodline
MyFirstID = !ID
.MoveNext
If Not .EOF Then
MyNextID = !ID
MyLastID = MyNextID - 1
fSetLines086 'call the function
Else
.MoveLast
MyLastID = !ID
fSetLines086 'call the function
End If
Next intI
.Close
End With
Set MyDB = Nothing
'======================== Step 7 ==========================
'===================== Delete the CRAP ====================
Me![txtProgress].Text = "Deleting non-valuable data."
Me.Refresh
DoCmd.Beep
Me![txtProgress].SelStart = 0
Wait 2, False
MySQL = "" 'Initialize String to nothing.
MySQL = MySQL & "DELETE IIf(IsNumeric([Cost1]),CCur([Cost1]),0) AS Expr1, "
MySQL = MySQL & "RPT086.Line1, RPT086.PartNumber1, RPT086.PerCar1, "
MySQL = MySQL & "RPT086.Retail1, RPT086.Cost1, RPT086.Core1, "
MySQL = MySQL & "RPT086.Description1 FROM RPT086 WHERE "
MySQL = MySQL & "(((IIf(IsNumeric([Cost1]),CCur([Cost1]),0))=0)); "
DoCmd.SetWarnings False
DoCmd.RunSQL (MySQL)
DoCmd.SetWarnings True
Me![txtProgress].Text = "Deletion of non-valuable data complete."
Me.Refresh
DoCmd.Beep
Me![txtProgress].SelStart = 0
Wait 2, False
'======================== Step 8 ==========================
'============== Check for Blank Line Codes ===============
' We need to ensure ALL PartNumbers have Line Codes before
' updating the Inventory table, or updates will get missed!
Dim CountBlanks As Integer
CountBlanks = DCount("PartNumber1", "RPT086", "IsNull([Line1])") +
DCount("PartNumber2", "RPT086", "IsNull([Line2])")
If CountBlanks 0 Then
Msg = ""
Msg = Msg & "The pricing table contains "
Msg = Msg & CountBlanks
Msg = Msg & " part numbers that do not have a line code." & CR & CR
Msg = Msg & "A form will open to allow you to fill these in"
Msg = Msg & "before updating the inventory table."
MsgBox (Msg)
'Open the form modally...i.e, after the form is closed,
'control will be returned to this procedure
DoCmd.OpenForm "frmUpdateLineCode086", , , , , acDialog
Me.Repaint
End If
Me![txtProgress].Text = "Line codes have been added successfully."
Me.Refresh
DoCmd.Beep
Me![txtProgress].SelStart = 0
Wait 2, False
'======================== Step 9 ==========================
'================= Merge Data to tblPricing ===============
Me![txtProgress].Text = "Merging imported 2-column data to a single-column
master pricing table."
Me.Refresh
DoCmd.Beep
Me![txtProgress].SelStart = 0
Wait 2, False
'Left side of RPT086
MySQL = "" 'Initialize String to nothing.
MySQL = MySQL & "INSERT INTO tblPricing ( Line, PartNumber, PerCar, Retail,
Cost, "
MySQL = MySQL & "Core, Description, PriceDate ) "
MySQL = MySQL & "SELECT RPT086.Line1, Trim([PartNumber1]) AS Expr1, "
MySQL = MySQL & "RPT086.PerCar1, CCur([Retail1]) AS Expr2, CCur([Cost1]) AS
Expr3, "
MySQL = MySQL & "CCur(Nz([Core1],0)) AS Expr4, Trim([Description1]) AS
Expr5,RPT086.RptDate "
MySQL = MySQL & "FROM RPT086; "
DoCmd.SetWarnings False
DoCmd.RunSQL (MySQL)
DoCmd.SetWarnings True
'Right side of RPT086
MySQL = "" 'Initialize String to nothing.
MySQL = MySQL & "INSERT INTO tblPricing ( Line, PartNumber, PerCar, Retail,
Cost, "
MySQL = MySQL & "Core, Description, PriceDate ) "
MySQL = MySQL & "SELECT RPT086.Line2, Trim([PartNumber2]) AS Expr1, "
MySQL = MySQL & "RPT086.PerCar2, CCur([Retail2]) AS Expr2, CCur([Cost2]) AS
Expr3, "
MySQL = MySQL & "CCur(Nz([Core2],0)) AS Expr4, Trim([Description2]) AS
Expr5,RPT086.RptDate "
MySQL = MySQL & "FROM RPT086; "
DoCmd.SetWarnings False
DoCmd.RunSQL (MySQL)
DoCmd.SetWarnings True
EliminateDupes086 ' Call the function
'Get rid of empty part numbers from 2nd column.
MySQL = "" 'Initialize String to nothing.
MySQL = MySQL & "Delete tblPricing.PartNumber, tblPricing.id FROM tblPricing
WHERE "
MySQL = MySQL & "(((tblPricing.PartNumber) Is Null)); "
DoCmd.SetWarnings False
DoCmd.RunSQL (MySQL)
DoCmd.SetWarnings True
'======================== Step 10 ==========================
'================ Update Inventory Pricing ================
Me![txtProgress].Text = "Revising Prices in Inventory table."
Me![txtProgress].SelStart = 0
Wait 2, False
MySQL = "" 'Initialize String to nothing.
MySQL = MySQL & "UPDATE tblPartsInventory INNER JOIN tblPricing ON"
MySQL = MySQL & "(tblPartsInventory.Line = tblPricing.Line) AND"
MySQL = MySQL & "(tblPartsInventory.PartNumber = tblPricing.PartNumber)"
MySQL = MySQL & " SET tblPartsInventory.Retail = [tblPricing]![Retail], "
MySQL = MySQL & "tblPartsInventory.Cost = [tblPricing]![Cost],"
MySQL = MySQL & " tblPartsInventory.PriceDate = [tblPricing]![PriceDate];"
'UPDATE tblPartsInventory INNER JOIN tblPricing ON
tblPartsInventory.PartNumber
'= tblPricing.PartNumber SET tblPartsInventory.Retail =
[tblPricing]![Retail],
'tblPartsInventory.Cost = [tblPricing]![Cost], tblPartsInventory.PriceDate =
[tblPricing]![PriceDate];
'Debug.Print MySQL
DoCmd.SetWarnings False
DoCmd.RunSQL (MySQL)
DoCmd.SetWarnings True
Me![sbfPriceDates].Form.Requery
Me![sbfPriceDates].SetFocus
DoCmd.GoToRecord , , acLast
Me![txtProgress].SetFocus
Me![txtProgress].Text = "Data import and conversion process completed."
Me![txtProgress].SelStart = 0
Wait 2, False
Me![txtProgress].SetFocus
Me![txtProgress].Text = ""
Me![sbfPriceDates].SetFocus
Me![txtProgress].Visible = False
' then open the dialog box / report.
cmdImport086_Exit:
Exit Sub
cmdImport086_Err:
MsgBox Error$
Resume cmdImport086_Exit
End Sub
"Bob" <sc*******@colonialfirststate.com.auwrote in message
news:11**********************@e65g2000hsc.googlegr oups.com...
Hi all,
I've got a table that I've imported and it has junk at the top of the
table, so after import I run a delete query to remove the junk lines
then I'm left with the field names I want for the table at the top of
the table but the field names currently are 'field1' etc, so how do I
rename the field names to the fields on the top row of the table.
Cheers,
Bob