我为帖子的长度道歉...我想尽可能详细地给你。我仍然是Access的业余爱好者，仍在学习VBA，所以要耐心等待我。代码将与我已更改的其他代码一起解析，以满足我的需求。
正在执行的任务：
1。）我正在使用VBA将多个excel文件从文件夹导入Access表。
2.）因为文件在一列中包含所有信息，所以我将该列隔离以隔离每个数据。
问题： 导入的每个Excel文件中的第一行都有一个文件引用名称（例如：CA051607GA）。我需要将其作为每行文件导入的行删除，并希望将其作为从该文件导入的每一行重复的新列。如果该记录存在问题，它将有助于我以后跟踪该文件。
1导入未更改的示例：
F1（＆lt; -field name）
第1行：CS16052702
第2行：00602498878941; US1A100037; US-G8; US1A100037; US-10
Row3：00602498878941; US1A100037; US-G8; US1A100037; US-10
2导入更改后的示例（宏）：
（每列的字段名称，但我无法弄清楚如何添加表格，因此分隔每个字段的时间段）
第1行：CS16052702
Row2：00602498878941 .... US1A100037 .... US-G8 .... US1A100037 .... US-10
Row3：00602498878941 .... US1A100037 .... US-G8 .... US1A100037 .... US-10
3所需输出示例（添加到宏）：
第1行： CS16052702 .... 00602498878941 .... US1A100037 .... US-G8 .... US1A100037 .... US-10
第2行： CS16052702 .... 00602498878941 .... US1A100037 .... US-G8 .... US1A100037 .... US-10
其他信息：
如果重要的话，我会说宏的性质，导入的文件在另一个之上。上面的示例仅显示一个文件导入，为了演示两个文件，您只需复制原始3行下面的3行（更改第1行以使其唯一）。我还包括我正在使用的宏供您参考。
Private Sub Command2_Click()
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
DoCmd.SetWarnings False
path = "C:\Users\BrooksJ\Desktop\Test\"
Dim rs As DAO.Recordset ' Moved from below
'Loop through the folder & build file list
strFile = Dir(path & "*.xls")
While strFile <> ""
'add files to the list
intFile = intFile + 1
ReDim Preserve strFileList(1 To intFile)
strFileList(intFile) = strFile
strFile = Dir()
Wend
'see if any files were found
If intFile = 0 Then
MsgBox "No files found"
Exit Sub
End If
'cycle through the list of files
For intFile = 1 To UBound(strFileList)
filename = path & strFileList(intFile)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Compare_Files", filename, False
Next intFile
DoCmd.SetWarnings True
'change import field name
' CurrentDb().TableDefs("Compare_Files").Fields("F1").Name = "UPC"
'create fields to sparse out original data field
' CurrentDb.Execute ("ALTER TABLE Compare_Files ADD COLUMN UPC Text;")
' CurrentDb.Execute ("ALTER TABLE Compare_Files ADD COLUMN SR_Profit_Center Text;")
' CurrentDb.Execute ("ALTER TABLE Compare_Files ADD COLUMN SR_Super_Label Text;")
' CurrentDb.Execute ("ALTER TABLE Compare_Files ADD COLUMN SAP_Profit_Center Text;")
' CurrentDb.Execute ("ALTER TABLE Compare_Files ADD COLUMN SAP_Super_Label Text;")
'Seperate data by ";" from original file
' Const YOUR_TABLE_NAME As String = "Compare_Files"
' Const SQL_UPDATE_DATA As String = "SELECT * FROM [" & YOUR_TABLE_NAME & "] WHERE SR_Profit_Center Is Null"
'
' Dim rs As DAO.Recordset
' Dim strF1Data As String
' Dim varData As Variant
'
' Set rs = CurrentDb.OpenRecordset(SQL_UPDATE_DATA)
' With rs
' Do Until .EOF
' strF1Data = !UPC
' varData = Split(strF1Data, ";")
' If UBound(varData) = 4 Then
' .Edit
' !UPC = varData(0)
' !SR_Profit_Center = varData(1)
' !SR_Super_Label = varData(2)
' !SAP_Profit_Center = varData(3)
' !SAP_Super_Label = varData(4)
' .Update
' End If
' .MoveNext
' Loop
' .Close
' End With
'
' Set rs = Nothing
'======================================================================================
CurrentDb.Execute ("ALTER TABLE Compare_Files ADD COLUMN UPC Text, SR_Profit_Center Text, SR_Super_Label Text, SAP_Profit_Center Text, SAP_Super_Label Text;")
CurrentDb.TableDefs("Compare_Files").Fields("F1").Name = "ref_val"
'Dim rs As DAO.Recordset
Dim ref_val As String
Set rs = db.OpenRecordset("SELECT TOP 1 ref_val FROM Compare_Files;", dbOpenDynaset)
ref_val = rs.Fields(0).Value
rs.Close
db.Execute "DELETE FROM [Compare_Files] WHERE ref_val = '" & ref_val & "';"
Const YOUR_TABLE_NAME As String = "Compare_Files"
Dim SQL_UPDATE_DATA As String
SQL_UPDATE_DATA = "SELECT *, ';' & '" & ref_val & "' FROM [" & YOUR_TABLE_NAME & "] WHERE SR_Profit_Center Is Null"
'Dim rs As DAO.Recordset
Dim strF1Data As String
Dim varData As Variant
Set rs = CurrentDb.OpenRecordset(SQL_UPDATE_DATA)
With rs
Do Until .EOF
strF1Data = !ref_val
varData = Split(strF1Data, ";")
If UBound(varData) = 4 Then
.Edit
!ref_val = ref_val
!UPC = varData(0)
!SR_Profit_Center = varData(1)
!SR_Super_Label = varData(2)
!SAP_Profit_Center = varData(3)
!SAP_Super_Label = varData(4)
.Update
End If
.MoveNext
Loop
.Close
End With
Set rs = Nothing
'==========================================================================================
End Sub
有些代码不会在代码框中捕获，因此我尝试尽可能地隔离代码。如果您需要我改变其阅读方式以使其更容易理解，请告诉我。
添加了备注：所引入的文件的行数不尽相同。
我感谢任何人都可以提供此问题的任何帮助或建议。如果您需要更多信息，请告诉我。我试着在我的问题中详细而详尽。
答案 0 :(得分：0)
有趣的问题，看起来你已经记录好了。我重新编辑了您的问题并使用{}图标阻止了顶级代码。输入文件中有多少行？可能有几种方法可以做到这一点，所以信息越多越好。我个人预先创建一个输入表，其中包含您希望它们命名的字段 - 读取存储var中第一行的所有文件，从剩余行中拆分字段，以及更新数据 - 但是＆＃＆＃ 39;导入预处理表可能更快，更有效 - 然后编写一个追加查询，使用mid $和instr函数更新字段。如果有错误的文件，那就不容易错误检查。 hmmmm。一些选择。
如果你回家后没有找到答案，我会看看能不能提出解决方案。打字现在很难
答案 1 :(得分：0)
快速而肮脏，以下调整将为您提供现在所需的位置。
首先，您可以简化ALTER TABLE声明：
CurrentDb.Execute ("ALTER TABLE Compare_Files ADD COLUMN UPC Text, SR_Profit_Center Text, SR_Super_Label Text, SAP_Profit_Center Text, SAP_Super_Label Text;")
2016-06-16 update：更正了代码以捕获正确的参考值并将其插入到逐行操作中。
CurrentDb.TableDefs("Compare_Files").Fields("F1").Name = "ref_val"
Const YOUR_TABLE_NAME As String = "Compare_Files"
Dim SQL_UPDATE_DATA As String
SQL_UPDATE_DATA = "SELECT * FROM [" & YOUR_TABLE_NAME & "]"
Dim rs As DAO.Recordset
Dim varData As Variant
Dim ref_val As String
Set rs = CurrentDb.OpenRecordset(SQL_UPDATE_DATA)
With rs
Do Until .EOF
varData = Split(!ref_val, ";")
If UBound(varData) = 4 Then
.Edit
!ref_val = ref_val
!UPC = varData(0)
!SR_Profit_Center = varData(1)
!SR_Super_Label = varData(2)
!SAP_Profit_Center = varData(3)
!SAP_Super_Label = varData(4)
.Update
Else
ref_val = !ref_val
rs.Delete
End If
.MoveNext
Loop
.Close
End With
Set rs = Nothing
正如dbmitch所说，有很多方法可以解决这类问题。如果/当您有机会时，请查看更改导入脚本以一次处理一个文件，并通过文件外部化循环（每次通过文件列表时调用导入例程一次）。这为您打开了一个完整的导入前和导入后选项。
我看到的另一个机会是尝试使用基于集合的方法替换逐行UPDATE。这可以是从导入登台表到另一个表的INSERT，或使用UPDATE使用字符串操作函数来检索分隔值的SELECT。