Option Compare Database
Public Function fileImportPuro()
'http://www.access-programmers.co.uk/forums/showthread.php?&p=628333#post628333 by rsmonkey
' Modified Ziggy Mar 25 2008
Dim strFile As String 'Filename
Dim strFileList() As String 'File Array
Dim intFile As Integer 'File Number
Dim filename As String
Dim path As String
Dim DEC As String ' check for second dot in filename and replace
Dim OldName, NewName, OrigName As String
Dim StrSQL As String
Dim qryDef As DAO.QueryDef
Dim filectr As Integer
filectr = 1
On Error GoTo ErrorHandler
' DoCmd.SetWarnings False
'Test locations
path = "paste your folderpath to import from"
'MsgBox path
'Loop through the folder & build file list
strFile = Dir(path & "*.csv")
While strFile <> ""
'add files to the list if meeting Criteria
'DEC = Len(strFile) ' checks filename length
DEC = Mid(strFile, 19, 4) ' Identifies if dot in 19th position zs you can also use LEN to check file length or a mixed string to check for.
If DEC = ".210" Then ' only valid files have dot +210 in 19th position zs
' If DEC = 14 Then ' only valid files with lenght of 14
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
End If
strFile = Dir()
Wend
'see if any files were found
If intFile = 0 Then
MsgBox "No 210 files found "
Exit Function
End If
'cycle through the list of files
For intFile = 1 To UBound(strFileList)
' Modified Ziggy
OrigName = strFileList(intFile)
OldName = path & strFileList(intFile)
'NewName = path & Left(strFileList(intFile), 10) & "BK.csv"
NewName = path & Left(strFileList(intFile), 18) & "-" & Mid(strFileList(intFile), 20, 3) & "BK.csv"
Name OldName As NewName ' Rename file
filename = NewName
DoCmd.TransferText acImportDelim, "Purolator4", "tblPuroInvoiceTEMP", filename, False, ""
'form for viewing SQL output..disabled
'DoCmd.OpenForm "form2"
'Forms.form2.txtsql = StrSQL
ErrorHandler:
'Display error information.
'MsgBox "Error number " & Err.Number & ": " & Err.Description
If Err.Number = 58 Then
Error2:
NewName = path & "DUPLICATE_" & filectr & "_" & strFileList(intFile)
MsgBox OrigName & " File already imported please confirm" & vbNewLine & vbNewLine & "Renaming to: " & "DUPLICATE_" & filectr & "_" & strFileList(intFile)
filectr = filectr + 1
Resume
On Error GoTo Error2
Name OldName As NewName ' Rename file
Exit Function
End If
' SQL for Append table to move data also adds the filename to a field for reference create a form to debug the SQL as some fields are tricky
StrSQL = "INSERT INTO tblPuroInvoice_App ( [PARTNER-TAG], [INV-NO], [MAIN-AC], [CUST-NAME], [HEADER-ADDR], [HEADER-CITY], PROV, PCODE, [DATE], [INV-ATTN], [CR-DB], [GIRV-CUST-CODE], [GIRV-PAY-CODE], [INV-TOTAL-AMT], [MATCH-SURCHARGE], [MATCH-SURCH-GST], [CONTRACT-NUM], [SAC-SUB-AC], [SAC-NAME], [SAC-ADDR], [SAC-CITY], [SAC-PROV], [SAC-PCODE], [SAC-INV-TOTAL-AMT], [REC-TYPE], [BL-NO], [SERV-DATE], PIECES, WT, [WT-UNITS], AMT, COLLECT, 900AM, BEYOND, [ACCOUNT-NO-CHG], [NON-PACK-SRCH], INSURANCE, [FUEL-SURCHARGE], DANGR, QUICKS, GST, [INCOMPLETE-ADDRESS], [COS-SURCH], [PC-FLAG], WEEKENDER, [NON-PACK-PIECES], [SERV-TYPE], REFERENCE, PRODUCT, [TRANS-CODE], PST, AOD, POD, PUROTHERM, ECO, [CONSOL-PIN], [CONSOL-CITY], [CONSOL-PROV], [WEIGHT-8], [CONSOL-SHIP], [SENDER-NAME], [SENDER-ADDR], [SENDER-UNIT], [FROM-CITY], [FROM-PROV], [FROM-POST-CODE], [RECEIVER-NAME], [RECEIVER-ADDR], [RECEIVER-UNIT], [TO-CITY], [TO-PROV], [TO-POST-CODE], [MAN-TOTAL-INV-AMT], [MANIFEST-NO], [CONT-NBR], [CONT-DESC1], [CONT-DESC2]," & _
"[CONT-BILL-AMT], [CONT-OVRWT-LB], [CONT-OVRWT-RATE], [CONT-FUEL-CHRG], [CONT-GST-CHRG], [CONT-PST-CHRG], [BANK-DESC], [BANK-DAYS], [BANK-AMT-PER-DAY], [BANK-NO-OF-LOC], [BANK-BILL-AMT], [BANK-FUEL-CHRG], [BANK-GST-CHRG], [BANK-NO], [BANK-PST-CHRG], [PARCEL-CUBE-VOL], Field94, filekey, AddDate )" & _
" SELECT tblPuroInvoiceTEMP.[PARTNER-TAG], tblPuroInvoiceTEMP.[INV-NO], tblPuroInvoiceTEMP.[MAIN-AC], tblPuroInvoiceTEMP.[CUST-NAME], tblPuroInvoiceTEMP.[HEADER-ADDR], tblPuroInvoiceTEMP.[HEADER-CITY], tblPuroInvoiceTEMP.PROV, tblPuroInvoiceTEMP.PCODE, tblPuroInvoiceTEMP.DATE, tblPuroInvoiceTEMP.[INV-ATTN], tblPuroInvoiceTEMP.[CR-DB], tblPuroInvoiceTEMP.[GIRV-CUST-CODE], tblPuroInvoiceTEMP.[GIRV-PAY-CODE], tblPuroInvoiceTEMP.[INV-TOTAL-AMT], tblPuroInvoiceTEMP.[MATCH-SURCHARGE], tblPuroInvoiceTEMP.[MATCH-SURCH-GST], tblPuroInvoiceTEMP.[CONTRACT-NUM], tblPuroInvoiceTEMP.[SAC-SUB-AC], tblPuroInvoiceTEMP.[SAC-NAME], tblPuroInvoiceTEMP.[SAC-ADDR], tblPuroInvoiceTEMP.[SAC-CITY], tblPuroInvoiceTEMP.[SAC-PROV], tblPuroInvoiceTEMP.[SAC-PCODE], tblPuroInvoiceTEMP.[SAC-INV-TOTAL-AMT], tblPuroInvoiceTEMP.[REC-TYPE], tblPuroInvoiceTEMP.[BL-NO], tblPuroInvoiceTEMP.[SERV-DATE], tblPuroInvoiceTEMP.PIECES, tblPuroInvoiceTEMP.WT, tblPuroInvoiceTEMP.[WT-UNITS], tblPuroInvoiceTEMP.AMT, tblPuroInvoiceTEMP.COLLECT," & _
"tblPuroInvoiceTEMP.[900AM] , tblPuroInvoiceTEMP.BEYOND, tblPuroInvoiceTEMP.[ACCOUNT-NO-CHG], tblPuroInvoiceTEMP.[NON-PACK-SRCH], tblPuroInvoiceTEMP.INSURANCE, tblPuroInvoiceTEMP.[FUEL-SURCHARGE], tblPuroInvoiceTEMP.DANGR, tblPuroInvoiceTEMP.QUICKS, tblPuroInvoiceTEMP.GST, tblPuroInvoiceTEMP.[INCOMPLETE-ADDRESS], tblPuroInvoiceTEMP.[COS-SURCH], tblPuroInvoiceTEMP.[PC-FLAG], tblPuroInvoiceTEMP.WEEKENDER, tblPuroInvoiceTEMP.[NON-PACK-PIECES], tblPuroInvoiceTEMP.[SERV-TYPE], tblPuroInvoiceTEMP.Reference, tblPuroInvoiceTEMP.PRODUCT, tblPuroInvoiceTEMP.[TRANS-CODE], tblPuroInvoiceTEMP.PST, tblPuroInvoiceTEMP.AOD, tblPuroInvoiceTEMP.POD, tblPuroInvoiceTEMP.PUROTHERM, tblPuroInvoiceTEMP.ECO, tblPuroInvoiceTEMP.[CONSOL-PIN], tblPuroInvoiceTEMP.[CONSOL-CITY], tblPuroInvoiceTEMP.[CONSOL-PROV], tblPuroInvoiceTEMP.[WEIGHT-8], tblPuroInvoiceTEMP.[CONSOL-SHIP], tblPuroInvoiceTEMP.[SENDER-NAME], tblPuroInvoiceTEMP.[SENDER-ADDR], tblPuroInvoiceTEMP.[SENDER-UNIT], tblPuroInvoiceTEMP.[FROM-CITY]," & _
"tblPuroInvoiceTEMP.[FROM-PROV] , tblPuroInvoiceTEMP.[FROM-POST-CODE] , tblPuroInvoiceTEMP.[RECEIVER-NAME], tblPuroInvoiceTEMP.[RECEIVER-ADDR], tblPuroInvoiceTEMP.[RECEIVER-UNIT], tblPuroInvoiceTEMP.[TO-CITY], tblPuroInvoiceTEMP.[TO-PROV], tblPuroInvoiceTEMP.[TO-POST-CODE], tblPuroInvoiceTEMP.[MAN-TOTAL-INV-AMT], tblPuroInvoiceTEMP.[MANIFEST-NO], tblPuroInvoiceTEMP.[CONT-NBR], tblPuroInvoiceTEMP.[CONT-DESC1], tblPuroInvoiceTEMP.[CONT-DESC2], tblPuroInvoiceTEMP.[CONT-BILL-AMT], tblPuroInvoiceTEMP.[CONT-OVRWT-LB], tblPuroInvoiceTEMP.[CONT-OVRWT-RATE], tblPuroInvoiceTEMP.[CONT-FUEL-CHRG], tblPuroInvoiceTEMP.[CONT-GST-CHRG], tblPuroInvoiceTEMP.[CONT-PST-CHRG], tblPuroInvoiceTEMP.[BANK-DESC], tblPuroInvoiceTEMP.[BANK-DAYS], tblPuroInvoiceTEMP.[BANK-AMT-PER-DAY], tblPuroInvoiceTEMP.[BANK-NO-OF-LOC], tblPuroInvoiceTEMP.[BANK-BILL-AMT], tblPuroInvoiceTEMP.[BANK-FUEL-CHRG], tblPuroInvoiceTEMP.[BANK-GST-CHRG], tblPuroInvoiceTEMP.[BANK-NO], tblPuroInvoiceTEMP.[BANK-PST-CHRG], tblPuroInvoiceTEMP.[PARCEL-CUBE-VOL]," & _
"tblPuroInvoiceTEMP.Field94," & "'" & OrigName & "'&" & " [tblPuroInvoiceTEMP.BL-NO]" & " as [filekey] , Now() AS AddDate" & _
" FROM tblPuroInvoiceTEMP;"
CurrentDb.Execute StrSQL
' Deletes the data in Temp table
DoCmd.OpenQuery "qryDelete_PuroInvoiceTEMP"
Next intFile
' DoCmd.SetWarnings True
End Function