I use this function to load CSV, txt and Excel files as part of the ETL Process.
An example of this function call is available within our sample app. The button “Import and Load” will first clear the existing data and then import any files which match the section name “Import Invoices” in the table tblimportGeneric
The tblImportGeneric has 3 different file types which can be explored in the table or the user maintenance form
Function ImportFile_Generic(tmpSectionName, tmpFoldertoUse, tmpCallingForm, Optional tmpRecid, Optional FilePrefix)
'=======================================================================================
' ImportFile_Generic
'Function ImportFile_Generic(tmpProcessName, tmpFoldertoUse, tmpArchiveFolder, tmpFiletoFind, tmpFindAll, tmpExcelorCSV, tmpImportSpec, _
' tmpAppendQuery, tmpImportTable, tmpAllowPause, tmpCallingForm, tmpClearHeader, tmpClearHeaderLine, tmpFieldtoTest, Optional tmpSheetName) ', Optional tmpArrayFields, Optional tmpTabletoUse)
'
'---------------------------------------------------------------------------------------
' Purpose : Generic import function for CSV / Excel files
' Author : Pat Jones
' Date : 15th Mar 2018
' Dependencies : FSO
' Notes :CSV imports to tblImport_tmp
' :Excel imports to tblDynamic (rename for new imports - using legacy queries)
' :G255 - opens csv / txt files greater than 255 columns and parses the contwent based on array of fields in ImportSpec
' Variables
' tmpProcessName - Message to send to user
' tmpFoldertoUse - Folder to get the files from
' tmpArchiveFolder - Archive folder to Use
' tmpFiletoFind - File pattern to match
' tmpFindAll - Find all - true or false for single
' tmpExcelorCSV - Excel CSV or G255
' tmpImportSpec - Import Spec for CSV or Array of field numbers for G255
' tmpImportTable - Table to import into
' tmpAppendQuery - Array of queries to run, if it starts with zzSQL then it uses the custom SQL Function
' tmpAllowPause - Allow the screen to pause to get the user message
' tmpCallingForm - Form making the call - can use me.name
' tmpClearHeader - Clear the imported header
' tmpClearHeaderLine - HEader Line to check for
' tmpFieldtoTest - Field to tes for the header value
'---------------------------------------------------------------------------------------
' Returns :string to define if successful or error
'---------------------------------------------------------------------------------------
' Tested :Nov 2019
' Revision History:1.8 Sept 2019
' Use tblImport_tmp for Excel, tblDynamic for CSV
' 1.2 fix missing declarations
' 1.3 Added array to queries to be run to allow multiple executes
' 1.4 Handle Apostrophe
' 1.5 Clear import temp table at the start to ensure its empty if we have no file
' 1.6 trim to 255 wide to allow for long footers
' 1.7 Change Text from VB to FSO to allow for files with LBlf rather than vbcrlf
' 1.8 File counter to avoid issues with destination file existing when importing small files
'=======================================================================================
On Error GoTo Errorhandler
Dim fso As FileSystemObject, tmpBuf
Dim sFilename, tmpTimeStamp, tmpArray, LineFromFile As String, RowNumber, tmpElement As Variant, i
Dim rst As Recordset, rstSource As Recordset, LineItem, tmpCount, tmpSQLExecError
Dim TS As TextStream, tmpErrorSection, tmpErrorDisplay, tmpFileCounter
'Declare variable for function
Dim tmpProcessName
Dim tmpArchiveFolder
Dim tmpFiletoFind
Dim tmpFindAll
Dim tmpExcelorCSV
Dim tmpImportSpec
Dim tmpAppendQuery
Dim tmpImportTable
Dim tmpAllowPause
Dim tmpClearHeader
Dim tmpClearHeaderLine
Dim tmpFieldtoTest
Dim tmpSheetName
Dim tmpOrgFileName ' stores the orig name for saving in the log
If IsMissing(tmpRecid) Then tmpRecid = 0
If IsMissing(FilePrefix) Then FilePrefix = ""
'check source folder
If Dir(tmpFoldertoUse, vbDirectory) = "" Then
ImportFile_Generic = tmpProcessName & " - Folder not Found " & tmpFoldertoUse
Exit Function
End If
'check file pattern
If Dir(tmpFoldertoUse & tmpFiletoFind) = "" Then
ImportFile_Generic = tmpProcessName & " - No files match pattern " & tmpFiletoFind
Exit Function
End If
'set recordsource to defined section name
Set rstSource = CurrentDb.OpenRecordset("Select * from tblImportGeneric where IG_Active=-1 and IG_SectionName='" & tmpSectionName & "'" & IIf(tmpRecid <> 0, " and IG_ID=" & tmpRecid, "") & " Order by IG_RunningOrder")
If rstSource.RecordCount = 0 Then
ImportFile_Generic = "No files for section " & tmpSectionName
Set rstSource = Nothing
Exit Function
End If
tmpFileCounter = 0
rstSource.MoveFirst
Do While Not rstSource.EOF 'loop for all in order
tmpFileCounter = tmpFileCounter + 1
tmpErrorSection = "Loading Variables"
tmpProcessName = rstSource!IG_ProcessName
tmpArchiveFolder = rstSource!IG_ArchiveFolder
tmpFiletoFind = rstSource!IG_FiletoFind
tmpFindAll = rstSource!IG_FindAll
tmpExcelorCSV = rstSource!IG_ImportType
tmpImportSpec = rstSource!IG_ImportSpec
tmpAppendQuery = rstSource!IG_ActionsAfterImport
tmpImportTable = rstSource!IG_ImportTable
tmpAllowPause = rstSource!IG_AllowPause
tmpClearHeader = rstSource!IG_ClearHeader
tmpClearHeaderLine = rstSource!IG_ClearHeaderLine
tmpFieldtoTest = rstSource!IG_FieldtoTest
tmpSheetName = rstSource!IG_SheetName
tmpErrorSection = "Clearing Tables"
'Clear the import table in case we have no data and other actions use that data
CurrentDb.Execute "delete * from " & tmpImportTable
tmpErrorSection = "Making folders"
If Dir(tmpFoldertoUse & tmpArchiveFolder, vbDirectory) = "" Then
MkDir tmpFoldertoUse & tmpArchiveFolder
End If
tmpErrorSection = "Setting reference to FSO"
'link to MS Scripting object
Set fso = CreateObject("Scripting.FileSystemObject")
'set the file to load
sFilename = Dir(tmpFoldertoUse & tmpFiletoFind)
If sFilename = "" Then
tmpProcessName = "No files to import"
GoTo AfterFileProcessed ' no file skip processing
End If
'set original file for renaming if required
tmpOrgFileName = sFilename
tmpErrorSection = "Start Type Selection"
Select Case tmpExcelorCSV
Case "CSV"
Do While sFilename <> ""
tmpFileCounter = tmpFileCounter + 1
If CheckFileLog(FilePrefix & sFilename) = True Then
Call UpdateStatus("File skipped - already imported " & tmpOrgFileName, tmpCallingForm, "Y")
Else
If tmpAllowPause And Len(tmpCallingForm & "") > 0 Then ' if we are refreshing user interface and a form name is passed
Call UpdateStatus("Importing file " & sFilename, tmpCallingForm)
DoEvents ' Allows a screen update
End If
If Len(sFilename) > 32 Then ' Only files with 32 len can be imported into Access
tmpTimeStamp = Format(Now(), "ddhhnnss")
fso.CopyFile tmpFoldertoUse & sFilename, tmpFoldertoUse & Trim(Left(tmpTimeStamp & "_" & Left(sFilename, Len(sFilename) - 4), 32) & ".csv")
fso.MoveFile tmpFoldertoUse & sFilename, tmpFoldertoUse & tmpArchiveFolder & tmpFileCounter & Format(Now(), "ddhhnnss") & "_" & sFilename
sFilename = Trim(Left(tmpTimeStamp & "_" & Left(sFilename, Len(sFilename) - 4), 32) & ".csv")
End If
If InStr(1, sFilename, "'", vbTextCompare) > 1 Then
tmpErrorSection = "Apostrophe extraction"
'check for apostrophe and advise user
tmpTimeStamp = Format(Now(), "ddhhnnss")
Call UpdateStatus("File has an apostrophe - File renamed " & sFilename, tmpCallingForm)
fso.CopyFile tmpFoldertoUse & sFilename, tmpFoldertoUse & Right(tmpTimeStamp & "_" & "Renamed" & Right(sFilename, 5), 32)
fso.MoveFile tmpFoldertoUse & sFilename, tmpFoldertoUse & tmpArchiveFolder & tmpFileCounter & Format(Now(), "ddhhnnss") & "_" & sFilename
sFilename = Right(tmpTimeStamp & "_" & "Renamed" & Right(sFilename, 5), 32)
End If
tmpErrorSection = "CSV Import"
DoCmd.SetWarnings False
DoCmd.TransferText acImportDelim, tmpImportSpec, tmpImportTable, tmpFoldertoUse & sFilename, False
CurrentDb.Execute "Update " & tmpImportTable & " set F115='" & FilePrefix & StripSpecial(tmpOrgFileName) & "' where Len(f115&'')=0"
tmpErrorSection = "Logging File Import"
Call Import_LogFile(FilePrefix & tmpOrgFileName, tmpProcessName, tmpCallingForm)
DoEvents
DoCmd.SetWarnings True
tmpErrorSection = "Archive File"
End If
fso.MoveFile tmpFoldertoUse & sFilename, tmpFoldertoUse & tmpArchiveFolder & tmpFileCounter & Format(Now(), "ddhhnnss") & "_" & sFilename
tmpErrorSection = "Reset File Selection"
If tmpFindAll Then ' Multiple file import
sFilename = Dir(tmpFoldertoUse & tmpFiletoFind)
tmpOrgFileName = sFilename
Else
GoTo Single_Import
End If
Loop
Case "Excel"
tmpErrorSection = "Excel File Type"
Do While sFilename <> ""
tmpFileCounter = tmpFileCounter + 1
If CheckFileLog(sFilename) = True Then
Call UpdateStatus("File skipped - already imported " & tmpOrgFileName, tmpCallingForm, "Y")
Else
If tmpAllowPause And Len(tmpCallingForm & "") > 0 Then ' if we are refreshing user interface and a form name is passed
Call UpdateStatus("Importing file " & sFilename, tmpCallingForm)
DoEvents ' Allows a screen update
End If
If InStr(1, sFilename, "'", vbTextCompare) > 1 Then
tmpErrorSection = "Apostrophe Extraction for Excel"
'check for apostrophe and advise user
tmpTimeStamp = Format(Now(), "ddhhnnss")
Call UpdateStatus("File has an apostrophe - File renamed " & sFilename, tmpCallingForm)
fso.CopyFile tmpFoldertoUse & sFilename, tmpFoldertoUse & Right(tmpTimeStamp & "_" & "Renamed" & Right(sFilename, 5), 32)
fso.MoveFile tmpFoldertoUse & sFilename, tmpFoldertoUse & tmpArchiveFolder & tmpFileCounter & Format(Now(), "ddhhnnss") & "_" & sFilename
sFilename = Right(tmpTimeStamp & "_" & "Renamed" & Right(sFilename, 5), 32)
End If
tmpErrorSection = "Sheet name definition"
If tmpSheetName <> "" Then
DoCmd.TransferSpreadsheet acImport, IIf(Right(sFilename, 1) = "x", acSpreadsheetTypeExcel12, acSpreadsheetTypeExcel9), tmpImportTable, tmpFoldertoUse & sFilename, False, tmpSheetName
Else
DoCmd.TransferSpreadsheet acImport, IIf(Right(sFilename, 1) = "x", acSpreadsheetTypeExcel12, acSpreadsheetTypeExcel9), tmpImportTable, tmpFoldertoUse & sFilename, False
End If
CurrentDb.Execute "Update " & tmpImportTable & " set F115='" & FilePrefix & StripSpecial(tmpOrgFileName) & "' where Len(f115&'')=0"
tmpErrorSection = "Excel import Logging"
Call Import_LogFile(FilePrefix & tmpOrgFileName, tmpProcessName, tmpCallingForm)
DoEvents
End If
tmpErrorSection = "Archive Excel import"
fso.MoveFile tmpFoldertoUse & sFilename, tmpFoldertoUse & tmpArchiveFolder & tmpFileCounter & Format(Now(), "ddhhnnss") & "_" & sFilename
tmpErrorSection = "Next file definition"
If tmpFindAll Then ' Multiple file import
sFilename = Dir(tmpFoldertoUse & tmpFiletoFind)
tmpOrgFileName = sFilename
Else
GoTo Single_Import
End If
Loop
Case "G255"
tmpErrorSection = "G255 Selection - Array"
tmpArray = Split(tmpImportSpec, ",")
Set rst = CurrentDb.OpenRecordset(tmpImportTable)
Do While sFilename <> ""
tmpFileCounter = tmpFileCounter + 1
tmpOrgFileName = sFilename
If CheckFileLog(sFilename) = True Then
Call UpdateStatus("File skipped - already imported " & tmpOrgFileName, tmpCallingForm, "Y")
Else
If tmpAllowPause And Len(tmpCallingForm & "") > 0 Then ' if we are refreshing user interface and a form name is passed
Call UpdateStatus("Importing file " & sFilename, tmpCallingForm)
DoEvents ' Allows a screen update
End If
tmpErrorSection = "Setting Textstream"
Set TS = fso.OpenTextFile(tmpFoldertoUse & sFilename, ForReading)
If Len(TS.ReadLine) > 3000 Then ' suggest we have an issue with no line return maybe a linux file
TS.Close
Set TS = fso.OpenTextFile(tmpFoldertoUse & sFilename)
tmpBuf = TS.ReadAll
TS.Close
Set TS = fso.OpenTextFile(tmpFoldertoUse & sFilename, ForWriting)
TS.Write Replace(tmpBuf, Chr(13), Chr(10) & Chr(13))
TS.Close
Set TS = fso.OpenTextFile(tmpFoldertoUse & sFilename, ForReading)
End If
RowNumber = 1
Do Until TS.AtEndOfStream 'EOF(1)
tmpErrorSection = "Start of text stream"
LineFromFile = TS.ReadLine
LineItem = splitLine2(LineFromFile)
'Debug.Print UBound(LineItem)
If Len(LineFromFile & "") > 0 Then ' to accommodate an empty final line
i = 1
rst.AddNew
tmpErrorSection = "Reading texts stream elements"
For Each tmpElement In tmpArray
If tmpElement <= UBound(LineItem) Then
rst.Fields("F" & i) = Trim(Left(Replace(LineItem(tmpElement), Chr(34), ""), 255)) ' trim to 255 wide to allow for long footers
End If
i = i + 1
Next tmpElement
rst.Update
End If
RowNumber = RowNumber + 1
Loop
Close #1
tmpErrorSection = "Closing text stream and archive"
Set TS = Nothing ' clear the lock on the file
CurrentDb.Execute "Update tblCSVImport set F115='" & FilePrefix & StripSpecial(tmpOrgFileName) & "' where Len(f115&'')=0"
tmpErrorSection = "Logging G355 File"
Call Import_LogFile(FilePrefix & tmpOrgFileName, tmpProcessName, tmpCallingForm)
DoEvents
End If
fso.MoveFile tmpFoldertoUse & sFilename, tmpFoldertoUse & tmpArchiveFolder & tmpFileCounter & Format(Now(), "ddhhnnss") & "_" & sFilename
tmpErrorSection = "Finding next G255 file"
If tmpFindAll Then ' Multiple file import
sFilename = Dir(tmpFoldertoUse & tmpFiletoFind)
tmpOrgFileName = sFilename
Else
GoTo Single_Import
End If
Loop
Case Else
ImportFile_Generic = tmpProcessName & " No import function found "
End Select
Single_Import:
tmpErrorSection = "Clearing Header line"
'clear the header line from the import table
If tmpClearHeader And Len(tmpClearHeaderLine & "") > 0 Then
CurrentDb.Execute "delete * from " & tmpImportTable & " where " & tmpFieldtoTest & "='" & tmpClearHeaderLine & "'"
End If
tmpErrorSection = "Running post import actions"
'if an append query has been passed then execute that query (must have prefix qry) - can also contain Custom SQL prefaced
If Len(tmpAppendQuery & "") <> 0 Then
DoCmd.SetWarnings False
LineItem = Split(tmpAppendQuery, ",") ' add the queries in the sequence you want them ran
tmpCount = UBound(LineItem)
i = 0
Do While i <= tmpCount
If Left(LineItem(i), 3) <> "qry" Then
tmpErrorSection = "Running Custom SQL"
tmpSQLExecError = Exec_CustomSQL(tmpCallingForm, Replace(LineItem(i), "zzSQL", "")) ' remove marker for custom SQL and execute
If tmpSQLExecError <> "All Completed" Then
Call UpdateStatus(tmpSQLExecError, tmpCallingForm, "Y")
End If
Else ' its already a query
tmpErrorSection = "Running QRY"
DoCmd.SetWarnings False
DoCmd.OpenQuery LineItem(i)
DoCmd.SetWarnings True
End If
i = i + 1
Loop
DoCmd.SetWarnings True
End If
AfterFileProcessed:
tmpErrorSection = "Clearing System Setting"
Set fso = Nothing
Set rst = Nothing
rstSource.MoveNext
Loop
Set fso = Nothing
Set rst = Nothing
Set TS = Nothing
ImportFile_Generic = "Process completed :" & Replace(tmpProcessName, "'", "")
Exit Function
Errorhandler:
If LogError(Err.Number, tmpErrorSection & " | " & Err.Description, GetSetting("Deck", "Login", "Username", "Not Logged in"), "ImportFile_Generic") = -1 Then
ImportFile_Generic = "Error " & Err.Number & " in section " & tmpErrorSection
Close #1
Resume Next
Else
Close #1
tmpErrorDisplay = "Error " & Err.Number & " in section " & tmpErrorSection
If MsgBox("Continue after this error ?", vbYesNo) = vbYes Then
Resume Next
Else
Exit Function
End If
End If
End Function
Related Posts
Preserving Excel Comments Across versions
You may need to save comment from one excel model...
Auto Unzipping Files and Loading of Excel Files
We used this function to automatically unzip Excel files ,...
Altova Mapforce
I am currently running a demo of the mapforce to...