将多个Excel文件导入一个Access表时如何添加文件名 [英] How to add file name when importing multiple Excel files to one Access table
问题描述
我正在使用Access VBA将多个Excel文件导入到我的Access数据库中.这将是一个每月过程,其中包含20-50个文件和10-60K个记录.我需要包含一个应用程序名称",该名称未包含在电子表格文件本身中,而是包含在其文件名中.与其手动将应用程序名称添加到Excel文件中,我不希望通过我的VBA代码添加它.
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.
我不擅长Access,并且通过搜索有关如何完成的内容将其中的大部分内容拼凑而成.这是可行的",但是当我在较大的批次上运行时,会收到错误消息运行时错误'3035':系统资源已超出".当我删除添加文件名(循环记录)的部分时,它运行良好.我认为这是因为这些步骤的效率不高吗?我们将提供任何帮助.
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
推荐答案
如果您取消了Recordset
,则代码将更简单并且运行时性能应该会更好.您可以在每个TransferSpreadsheet
The code is simpler and run-time performance should be much better if you eliminate the Recordset
. You can execute an UPDATE
after each TransferSpreadsheet
Dim strFolder As String
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strFile As String
Dim strTable As String
Dim strExtension As String
Dim lngFileType As Long
Dim strSQL As String
Dim strFullFileName As String
Dim varPieces As Variant
' --------------------------------------------------------
'* I left out the part where the user selects strFolder *'
' --------------------------------------------------------
strTable = "RawData" '<- this could be a constant instead of a variable
Set db = CurrentDb()
' make the UPDATE a parameter query ...
strSQL = "UPDATE [" & strTable & "] SET FileName=[pFileName]" & vbCrLf & _
"WHERE FileName Is Null OR FileName='';"
Set qdf = db.CreateQueryDef(vbNullString, strSQL)
strFile = Dir(strFolder & "*.xls*")
Do While Len(strFile) > 0
varPieces = Split(strFile, ".")
strExtension = varPieces(UBound(varPieces))
Select Case strExtension
Case "xls"
lngFileType = acSpreadsheetTypeExcel9
Case "xlsx", "xlsm"
lngFileType = acSpreadsheetTypeExcel12Xml
Case "xlsb"
lngFileType = acSpreadsheetTypeExcel12
End Select
strFullFileName = strFolder & strFile
DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadsheetType:=lngFileType, _
TableName:=strTable, _
FileName:=strFullFileName, _
HasFieldNames:=True ' or False if no headers
' supply the parameter value for the UPDATE and execute it ...
qdf.Parameters("pFileName").Value = strFile
qdf.Execute dbFailOnError
'Move to the next file
strFile = Dir
Loop
这篇关于将多个Excel文件导入一个Access表时如何添加文件名的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!