访问 VBA - 使用第一行数据创建新列答案

【问题标题】：Access VBA - create new column with first row of data访问 VBA - 使用第一行数据创建新列
【发布时间】：2016-06-10 01:17:31
【问题描述】：

对于帖子的长度，我深表歉意...我想为您提供尽可能详细的信息。我仍然是 Access 的业余爱好者，还在学习 VBA，所以请耐心等待。该代码是从我为满足我的需要而更改的其他代码中一起解析的。

正在执行的任务：

1.) 我正在使用 VBA 将文件夹中的几个 excel 文件导入到 Access 表中。

2.) 因为文件在一列中包含所有信息，所以我将分离该列以隔离每条数据。

问题： 每个导入的 Excel 文件的第一行都有一个文件引用名称（例如：CA051607GA）。我需要将其作为每个文件导入的一行删除，并希望将其设为在从该文件导入的每一行上重复的新列。如果该记录有问题，它将帮助我稍后能够追踪该文件。

1 导入未更改示例：

F1(

第 1 行：CS16052702

第 2 行：00602498878941;US1A100037;US-G8;US1A100037;US-10

第 3 行：00602498878941;US1A100037;US-G8;US1A100037;US-10

2 导入后更改示例（宏）：

（每列的字段名称，但我不知道如何添加表格，因此用句点分隔每个字段）

第 1 行：CS16052702

第 2 行：00602498878941....US1A100037....US-G8....US1A100037....US-10

第 3 行：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 行（更改第一行以使其唯一）。我还包括我正在使用的宏供您参考。

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

某些代码无法在代码框中捕获，因此我尝试尽我所能隔离代码。如果您需要我更改其读取方式以使其更易于理解，请告诉我。

补充说明：被拉入的文件的行数不同。

感谢任何人提供的有关此问题的任何帮助或建议。如果您需要更多信息，请告诉我。我试图在我的问题中详细而彻底。

【问题讨论】：

标签： vba ms-access macros

【解决方案1】：

快速而肮脏，以下调整将带您到现在需要的地方。

首先，您可以简化您的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 更新：更正代码以捕获正确的参考值并将其插入到逐行操作中。

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，或者使用SELECT 的UPDATE，它使用字符串操作函数来检索您的分隔值。

【讨论】：

感谢 Yllzaith 的帮助。我在以下行中收到“需要对象”错误：Set rs = db.OpenRecordset("SELECT TOP 1 ref_val FROM Compare_Files;") 我取消了原始代码中的单独数据片段，看起来您已将该片段包含在您的代码中。
确保Dim rs As DAO.Recordset 行已在您的代码中向上移动，就像在我的示例中一样。
我将原始帖子中的代码更新为我现在正在运行的代码。我仍然遇到同样的错误。
要么改变你所有的“db”。到“当前数据库”。或将Dim db as dao.database 和set db = currentdb 添加到代码顶部
是的，dbmitch 有正确的建议——我定义了一个数据库对象，但我没有包含在我在这里共享的内容中。我已经更正了我的代码。

【解决方案2】：

有趣的问题，看起来你已经很好地记录了它。我会重新编辑您的问题并使用 {} 图标阻止顶部代码。输入文件中有多少行？可能有几种方法可以做到这一点，因此信息越多越好。就我个人而言，我会预先创建一个输入表，其中包含您希望它们命名的字段 - 读取所有文件以将第一行存储在 var 中，将字段与剩余行分开，并更新数据 - 但它可能更快并且导入预处理表更有效 - 然后编写一个追加查询，使用 mid$ 和 instr 函数更新字段。如果存在错误文件，那么错误检查就不会那么容易了。嗯。几个选择。

如果我回家后你还没有找到答案，我会看看我是否能想出一个解决方案。现在打字很难

【讨论】：

输入文件可以有任意数量的行，通常在 1k-2k 范围内，但有时更少。为了确保我理解您的建议，您认为我应该创建一个已经填充标题的表（在宏之外），使用宏将文件拉入未编辑的表中，然后用预先存在的表填充以我想要的方式获取数据？
我会做的是个人喜好。但是如果你希望它能够处理文件错误，最好使用代码。我肯定会用正确的字段名称预设输入表 - 特别是如果所有数据都进入一个表并且字段名称不会改变。对于每行只有几字节的几千行，我会将整个文件读入一个字符串变量，根据 vbCRLF 拆分它，在每一行上循环，用“;”拆分然后每 100 行左右插入批量事务
我不确定我是否理解每 100 行左右的批量事务插入。那将如何运作？这会导致它不在每一行都显示批次名称吗？
对不起 - 只是一个同时做一堆事情的术语。看看msdn.microsoft.com/en-us/library/bb243806%28v=office.12%29.aspx
感谢您的建议。一旦我得到了这个工具的功能，我可能会在我有时间的时候回去改进它。这更像是一个边做边学的项目，所以我很欣赏资源和个人观点，你认为它会如何运作最好。