I am using Access VBA to import multiple Excel files into my Access database. This will be a monthly process with 20-50 files and 10-60K records. I need to include an "Application name" that isn't included within the spreadsheet file itself, but is in its file name. Rather than manually adding the application name to the Excel file I'd like to have it added via my VBA code.
I'm not proficient with Access and have pieced most of this together from searches on how to complete. This "works" but when I run it on larger batches I receive an error "Run-time error '3035': System resource exceeded.' When I remove the section that adds the file name (loop records) it runs fine. I think it's because the steps aren't ordered efficiently? Any help would be appreciated.
Public Function Import_System_Access_Reports()
Dim strFolder As String
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim rstTable As DAO.Recordset
Dim strFile As String
Dim strTable As String
Dim lngPos As Long
Dim strExtension As String
Dim lngFileType As Long
Dim strSQL As String
Dim strFullFileName As String
With Application.FileDialog(4) ' msoFileDialogFolderPicker
If .Show Then
strFolder = .SelectedItems(1)
Else
MsgBox "No folder specified!", vbCritical
Exit Function
End If
End With
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
strFile = Dir(strFolder & "*.xls*")
Do While strFile <> ""
lngPos = InStrRev(strFile, ".")
strTable = "RawData"
'MsgBox "table is:" & strTable
strExtension = Mid(strFile, lngPos + 1)
Select Case strExtension
Case "xls"
lngFileType = acSpreadsheetTypeExcel9
Case "xlsx", "xlsm"
lngFileType = acSpreadsheetTypeExcel12Xml
Case "xlsb"
lngFileType = acSpreadsheetTypeExcel12
End Select
DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadsheetType:=lngFileType, _
TableName:=strTable, _
FileName:=strFolder & strFile, _
HasFieldNames:=True ' or False if no headers
'Add and populate the new field
'set the full file name
strFullFileName = strFolder & strFile
'Initialize
Set db = CurrentDb()
Set tdf = db.TableDefs(strTable)
'Add the field to the table.
'tdf.Fields.Append tdf.CreateField("FileName", dbText, 255)
'Create Recordset
Set rstTable = db.OpenRecordset(strTable)
rstTable.MoveFirst
'Loop records
Do Until rstTable.EOF
If (IsNull(rstTable("FileName")) Or rstTable("FileName") = "") Then
rstTable.Edit
rstTable("FileName") = strFile
rstTable.Update
End If
rstTable.MoveNext
Loop
strFile = Dir
'Move to the next file
Loop
'Clean up
Set fld = Nothing
Set tdf = Nothing
Set db = Nothing
'rstTable.Close
Set rstTable = Nothing
End Function
The code is simpler and run-time performance should be much better if you eliminate the
Recordset
. You can execute anUPDATE
after eachTransferSpreadsheet