Euro5
asked on
Pull multiple cvs files into one access table
I need a code to pull hundreds of cvs files into one access table.
The files are identical in structure - just need to combine in a batch from desktop rather than one at a time.
Could I use VBA?
Can anyone help?
The files are identical in structure - just need to combine in a batch from desktop rather than one at a time.
Could I use VBA?
Can anyone help?
ASKER
Here is what I have...
but I am getting error on
Customer_Data ERROR Variable not defined.
but I am getting error on
Customer_Data ERROR Variable not defined.
Option Compare Database
Option Explicit
Function DoImport()
Dim strPathFile As String
Dim strFile As String
Dim strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in CSV worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Documents\ with the real path to the folder that
' contains the CSV files
strPath = "C:\Documents\Lorrie"
' Replace tablename with the real name of the table into which
' the data are to be imported
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strTable = Customer_Data
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
End Function
ASKER
This runs, but does not import my files!!
Option Compare Database
Option Explicit
Function DoImport()
Dim strPathFile As String
Dim strFile As String
Dim strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in CSV worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Documents\ with the real path to the folder that
' contains the CSV files
strPath = "C:\Users\542323\Documents\Lorrie"
' Replace tablename with the real name of the table into which
' the data are to be imported
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strTable = "Customer_Data"
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
' strFile = Dir()
Loop
End Function
ASKER
I am trying this code, but error on
You have entered an invalid reference to FileSearch
You have entered an invalid reference to FileSearch
Private Sub Test2()
'Enable the following references in the
' VBA screen under menu option Tools > References:
' Microsoft Office x.0 Object Library
' (where x is your version number, e.g. 10, 11, 12 etc)
'Note : This process assumes there is an import table already created
' with 3 fields called F1, F2 and F3 of the following types:
' F1 = Date, F2 = Number (not integer), F3 = Text
'Change the line below to the actual name of your
' import table in your database
Const MyImportTable As String = "Customer_Data"
'Change the line below to the name of the
' directory that contains the import files
Const MyImportFileDir As String = "C:\User\Lorrie"
Dim Counter As Integer, tmpName As String
On Error GoTo ErrorHandler
DoCmd.SetWarnings (False)
DoCmd.Hourglass (True)
'Remove the line below if you don't want to clear the import table
' when you run this process
'DoCmd.RunSQL "DELETE " & MyImportTable & ".* FROM " & MyImportTable & ";"
With Application.FileSearch
.NewSearch
.LookIn = MyImportFileDir
.SearchSubFolders = False 'set to True if you want to search subfolders too
.FileType = msoFileTypeAllFiles 'get all files in the directory
If .Execute() > 0 Then 'files found
For Counter = 1 To .FoundFiles.Count 'loop through files
.FileName = .FoundFiles(Counter) 'set / get the file name
DoCmd.TransferText , , MyImportTable, .FileName, False 'import file
tmpName = Mid$(.FileName, Len(.LookIn) + 2)
tmpName = Left$(tmpName, Len(tmpName) - 4)
'add the source file name to the import table
DoCmd.RunSQL "UPDATE " & MyImportTable & _
" SET " & MyImportTable & ".F3 = '" & tmpName & _
"' WHERE ((" & MyImportTable & ".F3) Is Null);"
Next Counter
'Remove the blank records created during the import
' due to the file headers (these may appear as import errors)
DoCmd.RunSQL "DELETE " & MyImportTable & _
".* FROM " & MyImportTable & _
" WHERE ((" & MyImportTable & ".F1) Is Null);"
MsgBox "Import complete.", vbInformation, "Done"
Else 'files not found
MsgBox "There were no files found.", vbCritical, "Error"
End If
End With
DoCmd.Hourglass (False)
DoCmd.SetWarnings (True)
ExitHere:
Exit Sub
ErrorHandler:
DoCmd.Hourglass (False)
DoCmd.SetWarnings (True)
MsgBox Err.Description, vbCritical, "Error# " & Err.Number
GoTo ExitHere
End Sub
Please explain
Customer_Data
for me, is it suppose to be a variable or its an identifier?
ASKER
That is supposed the be the identifier - the table name
ASKER
This code seems accurate and runs, but does not actually update the table.
Function DoImport()
Dim strPathFile As String
Dim strFile As String
Dim strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in CSV worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Documents\ with the real path to the folder that
' contains the CSV files
strPath = "C:\Users\542323\Documents\Lorrie"
' Replace tablename with the real name of the table into which
' the data are to be imported
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strTable = "Customer_Data"
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
End Function
ASKER
Changed to
Option Explicit
with code above
Option Explicit
with code above
ASKER
This runs until Do While Len(strFile) > 0
Where it stops - but no error
Option Explicit
Public Sub DoImport()
Dim strPathFile As String
Dim strFile As String
Dim strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in CSV worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Documents\ with the real path to the folder that
' contains the CSV files
strPath = "C:\Users\542323\Documents \Lorrie"
' Replace tablename with the real name of the table into which
' the data are to be imported
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strTable = "Customer_Data"
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
End Sub
Where it stops - but no error
Option Explicit
Public Sub DoImport()
Dim strPathFile As String
Dim strFile As String
Dim strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in CSV worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Documents\ with the real path to the folder that
' contains the CSV files
strPath = "C:\Users\542323\Documents
' Replace tablename with the real name of the table into which
' the data are to be imported
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strTable = "Customer_Data"
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
End Sub
You need to change that and use something like this
For Each xFile In strFile
this should solve your problem
regarding the loop through each file.
ASKER
I have no idea what to do with this.
Here is working code from one of my applications. It takes all the files in the specified folder and imports them. It is a two step process because the .xlsx files are reports rather than tables so they get imported into a temp table first and then appended to the checks table.
It requires a reference to the Microsoft Scripting runtime.
It requires a reference to the Microsoft Scripting runtime.
Private Sub cmdImport_Click()
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim rs As DAO.Recordset
Dim strProcessed As String
Dim fs As Scripting.FileSystemObject
Dim folder As Scripting.folder
Dim file As Scripting.file
Dim filefolder
Dim ToFolderName As String
Dim CountBankInput As Long
Dim CountChecksBefore As Long
Dim CountChecksAfter As Long
Dim FileCounter As Long
Dim FileName As String
Dim LastImport As Variant
On Error GoTo Err_Proc
If Me.txtFolder & "" = "" Then
MsgBox "Please select a folder to import.", vbOKOnly
Exit Sub
End If
Set db = CurrentDb()
Set td = db.TableDefs!tblImportLog
Set rs = td.OpenRecordset
Set fs = CreateObject("Scripting.FileSystemObject")
Set folder = fs.GetFolder(Me.txtFolder)
Set filefolder = folder.Files
FileCounter = 0
For Each file In filefolder
If file.Type = "Microsoft Excel Worksheet" Then
FileCounter = FileCounter + 1
FileName = folder.Path
If Right(FileName, 1) = "\" Then
FileName = FileName & file.Name
Else
FileName = FileName & "\" & file.Name
End If
LastImport = DMax("SourceFileName", "tblImportLog")
If file.Name > LastImport Or IsNull(LastImport) Then
Else
If file.Name = DLookup("SourceFileName", "tblImportLog", "SourceFileName = '" & file.Name & "'") Then
MsgBox "This file has already been imported. Please remove it from the import folder and start again.", vbOKOnly
Exit Sub
Else
MsgBox "This file name is from a prior period. Please have the programmer validate the data before continuing.", vbOKOnly
Exit Sub
End If
End If
Me.txtFile = FileName
Me.Repaint
rs.AddNew
rs!sourcefilename = Mid(Me.txtFile, InStrRev(Me.txtFile, "\") + 1)
rs!sourcepathname = Left(Me.txtFile, InStrRev(Me.txtFile, "\"))
rs!ImportDT = Date
Me.txtBatchID = rs!BatchID 'will not work with SQL Server
GoSub FileProcess
rs!RecCount = DCount("*", "tblBankInput", "SourceFileName = '" & file.Name & "'")
rs.Update
End If
Next
Me.Repaint
FileProcess:
strProcessed = Replace(Me.txtFile, "\Output\", "\Processed\")
ToFolderName = Left(strProcessed, InStrRev(strProcessed, "\"))
DoCmd.RunMacro "mWarningsOff"
CountBankInput = 0
CountChecksBefore = 0
CountChecksAfter = 0
'empty work tables
DoCmd.OpenQuery "qDelSheet1"
'import spreadsheet
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "Sheet1", Me.txtFile, False
'append to work table
DoCmd.OpenQuery "qAppFirstColumns"
DoCmd.OpenQuery "qAppSecondColumns"
CountBankInput = DCount("*", "tblBankInput")
CountChecksBefore = DCount("*", "tblChecks")
'append new items to final table
DoCmd.OpenQuery "qAppChecks"
CountChecksAfter = DCount("*", "tblChecks")
'update existing items in final table
DoCmd.OpenQuery "qUpdChecks_CD1"
DoCmd.OpenQuery "qUpdChecks_CD2"
DoCmd.OpenQuery "qUpdChecks_CD3"
DoCmd.OpenQuery "qUpdChecks_CD4"
DoCmd.OpenQuery "qUpdChecks_CD5"
DoCmd.OpenQuery "qUpdChecks_CDNone"
fs.CopyFile Source:=Me.txtFile, Destination:=ToFolderName
Kill Me.txtFile
Return
Exit_Proc:
DoCmd.RunMacro "mWarningsOn"
MsgBox "Complete " & FileCounter & " files imported.", vbOKOnly
Exit Sub
Err_Proc:
Select Case Err.Number
Case Else
MsgBox Err.Number & "--" & Err.Description
Resume Exit_Proc
Resume
End Select
End Sub
Your problem is within your directory/file looping. Do this
First try this out and see. Also I couldn't test your
Dim strPath As DirectoryInfo = _
New DirectoryInfo("C:\Users\542323\Documents\Lorrie\")
Dim fi As FileInfo() = strPath.GetFiles("*.csv")
Dim fri As FileInfo
' Now loop through each file
For Each fri In fi
' Now you can do what you want to do here, this will be done on each matching file.
strTable = "Customer_Data"
strPathFile = fri.FullName
Try
DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
Catch ex As Exception
MsgBox(ex.Message) ' This will return an error message if there is any error occurs.
End Try
First try this out and see. Also I couldn't test your
DoCmd.TransferText....
but the above code should help you loop through each file, you will need to ensure that your code that I've just stated that I haven't tested you need to make sure it execute, also you need to use Try to catch exceptions
ASKER
I get error msgs -
Dim strPath As DirectoryInfo = _
New DirectoryInfo("C:\Users\54 2323\Docum ents\Lorri e\")
and
Dim fi As FileInfo() = strPath.GetFiles("*.csv")
many errors throughout - is this for Access?
Dim strPath As DirectoryInfo = _
New DirectoryInfo("C:\Users\54
and
Dim fi As FileInfo() = strPath.GetFiles("*.csv")
many errors throughout - is this for Access?
What is the error message you are getting? Also the above will require you to import the
I suggest to test the above, create a test project and test on it and do adjustments you need on it then you will have the full working solution which you can then take it to your project.
System.IO
post the error message so I can take a look at it, also where does it occurs?I suggest to test the above, create a test project and test on it and do adjustments you need on it then you will have the full working solution which you can then take it to your project.
ASKER
mlungisi ndlela
How do I import the System IO?
Thanks so much for your help!
I feel very lost on this.
testLorrie.JPG
How do I import the System IO?
Thanks so much for your help!
I feel very lost on this.
testLorrie.JPG
ASKER
I tried to include it above
Import System.IO
Sub ImportData()
Dim strPath As DirectoryInfo = _
New DirectoryInfo("C:\Users\542323\Documents\Lorrie\")
Dim fi As FileInfo() = strPath.GetFiles("*.csv")
Dim fri As FileInfo
' Now loop through each file
For Each fri In fi
' Now you can do what you want to do here, this will be done on each matching file.
strTable = "Customer_Data"
strPathFile = fri.FullName
Try
DoCmd.TransferText acImportDelim, , strTable, strPathFile, blnHasFieldNames
Catch ex As Exception
MsgBox (ex.Message) ' This will return an error message if there is any error occurs.
End Try
End Sub
You are not using VB.NET, I think you are using VB6 or VB5 not sure, which Visual Basic are you using because that error message box I mostly see it on VB5.0?
Secondly on this code
You can't downgrade but you can upgrade, in order to downgrade you will need to change the code to a code understood by your IDE.
Dim strPath As DirectoryInfo = _
New DirectoryInfo("C:\Users\542323\Documents\Lorrie\")
change it to
Dim strPath As DirectoryInfo = New DirectoryInfo("C:\Users\542323\Documents\Lorrie\")
and also this code is a VB.NET code which I doubt it will function proper on VB6/5.0/3...., Tell me what version of VB you are using, I also have VB5.0 here so I can try helping you out. Also what you should know with older versions is that they use
Dir()
function for directory which is also supported by VB.NET.You can't downgrade but you can upgrade, in order to downgrade you will need to change the code to a code understood by your IDE.
ASKER
I am using Access 2013.
Did you take a look at the procedure I posted? It is Access VBA and it works. You just have to customize it.
ASKER
PatHartman
I did, but I couldn't figure out how to customize.
I am not sure how a lot of the code compares to mine.
Would love to have it work!
I did, but I couldn't figure out how to customize.
I am not sure how a lot of the code compares to mine.
Would love to have it work!
'append new items to final table
DoCmd.OpenQuery "qAppChecks"
CountChecksAfter = DCount("*", "tblChecks")
'update existing items in final table
DoCmd.OpenQuery "qUpdChecks_CD1"
DoCmd.OpenQuery "qUpdChecks_CD2"
DoCmd.OpenQuery "qUpdChecks_CD3"
DoCmd.OpenQuery "qUpdChecks_CD4"
DoCmd.OpenQuery "qUpdChecks_CD5"
DoCmd.OpenQuery "qUpdChecks_CDNone"
You can ignore the update queries since they update the data after it is imported.
The app imports the initial spreadsheet into a temp table. The spreadsheet is a "report" and has two "columns" of data. The columns snake. So the left set of columns is records 1-30 and the second set of columns is records 31-60. So there is a lot of extra work that is happening. You haven't really told us what work you are doing beyond importing. You just want to get to the import.
You were obviously having trouble working with air code so I did not want to take a chance on deleting something important so I just left the procedure intact.
The following is not really relevant to your task:
'append to work table
DoCmd.OpenQuery "qAppFirstColumns"
DoCmd.OpenQuery "qAppSecondColumns"
CountBankInput = DCount("*", "tblBankInput")
CountChecksBefore = DCount("*", "tblChecks")
'append new items to final table
DoCmd.OpenQuery "qAppChecks"
CountChecksAfter = DCount("*", "tblChecks")
'update existing items in final table
DoCmd.OpenQuery "qUpdChecks_CD1"
DoCmd.OpenQuery "qUpdChecks_CD2"
DoCmd.OpenQuery "qUpdChecks_CD3"
DoCmd.OpenQuery "qUpdChecks_CD4"
DoCmd.OpenQuery "qUpdChecks_CD5"
DoCmd.OpenQuery "qUpdChecks_CDNone"
Once you get beyond the TransferSpreadsheet, you are into whatever you want to do with the data after you import/link the spreadsheet. Notice that I am reusing the same working table for each file so qDelSheet1 removes the rows before importing the new data. You can use acLink instead of acImport. I chose to import because I wanted more control over the process since the data was frequently bad and the append and update queries cleaned it up.
The two macros - mWarningsOff and mWarningsOn are the ONLY macros I ever use. I use a macro to control the warnings because when I turn warnings off, I want to turn the hourglass on and vice versa. The macro is a convenient way to do that without having to remember to always write the two lines of code. It is EXTREMELY important that you never leave warning off. Leaving them off while in development mode could cause you to lose hours of work if you forget to specifically save before you close an object you have been modifying. Access will silently discard any unsaved changes because you said to turn warnings off. You only have to be burned once to never forget the experience.
The app imports the initial spreadsheet into a temp table. The spreadsheet is a "report" and has two "columns" of data. The columns snake. So the left set of columns is records 1-30 and the second set of columns is records 31-60. So there is a lot of extra work that is happening. You haven't really told us what work you are doing beyond importing. You just want to get to the import.
You were obviously having trouble working with air code so I did not want to take a chance on deleting something important so I just left the procedure intact.
The following is not really relevant to your task:
'append to work table
DoCmd.OpenQuery "qAppFirstColumns"
DoCmd.OpenQuery "qAppSecondColumns"
CountBankInput = DCount("*", "tblBankInput")
CountChecksBefore = DCount("*", "tblChecks")
'append new items to final table
DoCmd.OpenQuery "qAppChecks"
CountChecksAfter = DCount("*", "tblChecks")
'update existing items in final table
DoCmd.OpenQuery "qUpdChecks_CD1"
DoCmd.OpenQuery "qUpdChecks_CD2"
DoCmd.OpenQuery "qUpdChecks_CD3"
DoCmd.OpenQuery "qUpdChecks_CD4"
DoCmd.OpenQuery "qUpdChecks_CD5"
DoCmd.OpenQuery "qUpdChecks_CDNone"
Once you get beyond the TransferSpreadsheet, you are into whatever you want to do with the data after you import/link the spreadsheet. Notice that I am reusing the same working table for each file so qDelSheet1 removes the rows before importing the new data. You can use acLink instead of acImport. I chose to import because I wanted more control over the process since the data was frequently bad and the append and update queries cleaned it up.
The two macros - mWarningsOff and mWarningsOn are the ONLY macros I ever use. I use a macro to control the warnings because when I turn warnings off, I want to turn the hourglass on and vice versa. The macro is a convenient way to do that without having to remember to always write the two lines of code. It is EXTREMELY important that you never leave warning off. Leaving them off while in development mode could cause you to lose hours of work if you forget to specifically save before you close an object you have been modifying. Access will silently discard any unsaved changes because you said to turn warnings off. You only have to be burned once to never forget the experience.
ASKER
Right, I just need to get the sheets into one Access table.
The problem is I have hundreds of these .csv files, so I can't possibly do them one at a time.
So this is what I am working with?
I get an error "Invalid use of ME keyword"
Private Sub cmdImport_Click()
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim rs As DAO.Recordset
Dim strProcessed As String
Dim fs As Scripting.FileSystemObject
Dim folder As Scripting.folder
Dim file As Scripting.file
Dim filefolder
Dim ToFolderName As String
Dim CountBankInput As Long
Dim CountChecksBefore As Long
Dim CountChecksAfter As Long
Dim FileCounter As Long
Dim FileName As String
Dim LastImport As Variant
On Error GoTo Err_Proc
If Me.txtFolder & "" = "" Then
MsgBox "Please select a folder to import.", vbOKOnly
Exit Sub
End If
Set db = CurrentDb()
Set td = db.TableDefs!tblImportLog
Set rs = td.OpenRecordset
Set fs = CreateObject("Scripting.Fi leSystemOb ject")
Set folder = fs.GetFolder(Me.txtFolder)
Set filefolder = folder.Files
FileCounter = 0
For Each file In filefolder
If file.Type = "Microsoft Excel Worksheet" Then
FileCounter = FileCounter + 1
FileName = folder.Path
If Right(FileName, 1) = "\" Then
FileName = FileName & file.Name
Else
FileName = FileName & "\" & file.Name
End If
LastImport = DMax("SourceFileName", "tblImportLog")
If file.Name > LastImport Or IsNull(LastImport) Then
Else
If file.Name = DLookup("SourceFileName", "tblImportLog", "SourceFileName = '" & file.Name & "'") Then
MsgBox "This file has already been imported. Please remove it from the import folder and start again.", vbOKOnly
Exit Sub
Else
MsgBox "This file name is from a prior period. Please have the programmer validate the data before continuing.", vbOKOnly
Exit Sub
End If
End If
Me.txtFile = FileName
Me.Repaint
rs.AddNew
rs!sourceFileName = Mid(Me.txtFile, InStrRev(Me.txtFile, "\") + 1)
rs!sourcepathname = Left(Me.txtFile, InStrRev(Me.txtFile, "\"))
rs!ImportDT = Date
Me.txtBatchID = rs!BatchID 'will not work with SQL Server
GoSub FileProcess
rs!RecCount = DCount("*", "tblBankInput", "SourceFileName = '" & file.Name & "'")
rs.Update
End If
Next
Me.Repaint
FileProcess:
strProcessed = Replace(Me.txtFile, "\Output\", "\Processed\")
ToFolderName = Left(strProcessed, InStrRev(strProcessed, "\"))
DoCmd.RunMacro "mWarningsOff"
CountBankInput = 0
CountChecksBefore = 0
CountChecksAfter = 0
'empty work tables
DoCmd.OpenQuery "qDelSheet1"
'import spreadsheet
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xm l, "Sheet1", Me.txtFile, False
Return
Exit_Proc:
DoCmd.RunMacro "mWarningsOn"
MsgBox "Complete " & FileCounter & " files imported.", vbOKOnly
Exit Sub
Err_Proc:
Select Case Err.Number
Case Else
MsgBox Err.Number & "--" & Err.Description
Resume Exit_Proc
Resume
End Select
End Sub
The problem is I have hundreds of these .csv files, so I can't possibly do them one at a time.
So this is what I am working with?
I get an error "Invalid use of ME keyword"
Private Sub cmdImport_Click()
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim rs As DAO.Recordset
Dim strProcessed As String
Dim fs As Scripting.FileSystemObject
Dim folder As Scripting.folder
Dim file As Scripting.file
Dim filefolder
Dim ToFolderName As String
Dim CountBankInput As Long
Dim CountChecksBefore As Long
Dim CountChecksAfter As Long
Dim FileCounter As Long
Dim FileName As String
Dim LastImport As Variant
On Error GoTo Err_Proc
If Me.txtFolder & "" = "" Then
MsgBox "Please select a folder to import.", vbOKOnly
Exit Sub
End If
Set db = CurrentDb()
Set td = db.TableDefs!tblImportLog
Set rs = td.OpenRecordset
Set fs = CreateObject("Scripting.Fi
Set folder = fs.GetFolder(Me.txtFolder)
Set filefolder = folder.Files
FileCounter = 0
For Each file In filefolder
If file.Type = "Microsoft Excel Worksheet" Then
FileCounter = FileCounter + 1
FileName = folder.Path
If Right(FileName, 1) = "\" Then
FileName = FileName & file.Name
Else
FileName = FileName & "\" & file.Name
End If
LastImport = DMax("SourceFileName", "tblImportLog")
If file.Name > LastImport Or IsNull(LastImport) Then
Else
If file.Name = DLookup("SourceFileName", "tblImportLog", "SourceFileName = '" & file.Name & "'") Then
MsgBox "This file has already been imported. Please remove it from the import folder and start again.", vbOKOnly
Exit Sub
Else
MsgBox "This file name is from a prior period. Please have the programmer validate the data before continuing.", vbOKOnly
Exit Sub
End If
End If
Me.txtFile = FileName
Me.Repaint
rs.AddNew
rs!sourceFileName = Mid(Me.txtFile, InStrRev(Me.txtFile, "\") + 1)
rs!sourcepathname = Left(Me.txtFile, InStrRev(Me.txtFile, "\"))
rs!ImportDT = Date
Me.txtBatchID = rs!BatchID 'will not work with SQL Server
GoSub FileProcess
rs!RecCount = DCount("*", "tblBankInput", "SourceFileName = '" & file.Name & "'")
rs.Update
End If
Next
Me.Repaint
FileProcess:
strProcessed = Replace(Me.txtFile, "\Output\", "\Processed\")
ToFolderName = Left(strProcessed, InStrRev(strProcessed, "\"))
DoCmd.RunMacro "mWarningsOff"
CountBankInput = 0
CountChecksBefore = 0
CountChecksAfter = 0
'empty work tables
DoCmd.OpenQuery "qDelSheet1"
'import spreadsheet
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xm
Return
Exit_Proc:
DoCmd.RunMacro "mWarningsOn"
MsgBox "Complete " & FileCounter & " files imported.", vbOKOnly
Exit Sub
Err_Proc:
Select Case Err.Number
Case Else
MsgBox Err.Number & "--" & Err.Description
Resume Exit_Proc
Resume
End Select
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
PatHartman - Got it. I didn't create a button , so I will do that.
Open in new window
loop may help you. Show us what you have done so far.