求助编写VBA代码实现多CSV文件动态数据批量导入Access

嘿，我明白你的需求了——要批量处理带两组动态数据的文件，分别导入到Access的两个表中，核心难点就是定位第二组数据的起始位置。结合你已有的代码，我来帮你完善这部分逻辑：

核心思路 #

要定位第二组数据，我们可以按以下步骤来：

• 先找到第一组数据的最后一行：从A4开始向下遍历，直到找到A列的最后一个非空行（因为第一组数据是连续的）
• 跳过中间的空行和需要忽略的文本行：从第一组结束行往下找，直到找到第二组数据的起始行（第一个有有效数据的行，对应列数为19列）
• 再找到第二组数据的最后一行：从起始行向下遍历到A列最后一个非空行

完整代码示例 #

我基于你的现有代码补充了定位第二组数据的逻辑，还加入了批量选文件的功能，方便一次性处理多个SourceDataXXX文件：

Sub ImportMultipleCSVsToAccess()
    ' Access 变量
    Dim dbFile As Database
    Dim rstFirstGroup As Recordset ' 第一组数据目标表的记录集
    Dim rstSecondGroup As Recordset ' 第二组数据目标表的记录集
    
    ' Excel 变量
    Dim xlApp As Excel.Application
    Dim xlFile As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim firstGroupStartRow As Long, firstGroupEndRow As Long
    Dim secondGroupStartRow As Long, secondGroupEndRow As Long
    Dim currentRow As Long
    Dim fDialog As FileDialog
    Dim selectedFile As Variant
    
    ' 初始化Access数据库连接
    Set dbFile = CurrentDb
    ' 打开两个目标表的记录集（替换成你实际的表名）
    Set rstFirstGroup = dbFile.OpenRecordset("FirstGroupTable", dbOpenDynaset)
    Set rstSecondGroup = dbFile.OpenRecordset("SecondGroupTable", dbOpenDynaset)
    
    ' 创建文件选择对话框，支持多选CSV/Excel文件
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = True
        .Filters.Add "CSV/Excel Files", "*.csv;*.xlsx;*.xls"
        .Title = "选择要导入的SourceDataXXX文件"
        If .Show = -1 Then
            ' 后台启动Excel，不显示界面
            Set xlApp = New Excel.Application
            xlApp.Visible = False
            
            ' 遍历选中的每个文件
            For Each selectedFile In .SelectedItems
                Set xlFile = xlApp.Workbooks.Open(selectedFile)
                ' 注意：纯CSV文件打开后只有1个工作表；如果是Excel文件，替换成"InputData"
                Set xlSheet = xlFile.Sheets(1) ' 若是Excel文件，改为xlFile.Sheets("InputData")
                
                ' --------------------------
                ' 定位并导入第一组数据
                ' --------------------------
                firstGroupStartRow = 4 ' 固定从A4开始
                ' 找到第一组数据的最后一行（A列最后一个非空行）
                firstGroupEndRow = xlSheet.Cells(xlSheet.Rows.Count, "A").End(xlUp).Row
                ' 确保第一组数据存在
                If firstGroupEndRow >= firstGroupStartRow Then
                    ' 循环插入第一组7列数据到Access表
                    For currentRow = firstGroupStartRow To firstGroupEndRow
                        rstFirstGroup.AddNew
                        rstFirstGroup.Fields(0) = xlSheet.Cells(currentRow, "A").Value
                        rstFirstGroup.Fields(1) = xlSheet.Cells(currentRow, "B").Value
                        rstFirstGroup.Fields(2) = xlSheet.Cells(currentRow, "C").Value
                        rstFirstGroup.Fields(3) = xlSheet.Cells(currentRow, "D").Value
                        rstFirstGroup.Fields(4) = xlSheet.Cells(currentRow, "E").Value
                        rstFirstGroup.Fields(5) = xlSheet.Cells(currentRow, "F").Value
                        rstFirstGroup.Fields(6) = xlSheet.Cells(currentRow, "G").Value
                        rstFirstGroup.Update
                    Next currentRow
                End If
                
                ' --------------------------
                ' 定位并导入第二组数据
                ' --------------------------
                ' 从第一组结束行往下，跳过空行和忽略行
                currentRow = firstGroupEndRow + 1
                Do While currentRow <= xlSheet.Rows.Count
                    ' 跳过空行
                    If Trim(xlSheet.Cells(currentRow, "A").Value) = "" Then
                        currentRow = currentRow + 1
                    Else
                        ' 判断是否是需要忽略的文本行（替换成你实际的忽略行标识）
                        If Trim(xlSheet.Cells(currentRow, "A").Value) = "此处是需忽略的文本" Then
                            currentRow = currentRow + 1
                        Else
                            secondGroupStartRow = currentRow
                            Exit Do
                        End If
                    End If
                Loop
                
                ' 找到第二组数据的最后一行
                secondGroupEndRow = xlSheet.Cells(xlSheet.Rows.Count, "A").End(xlUp).Row
                ' 确保第二组数据存在
                If secondGroupEndRow >= secondGroupStartRow Then
                    ' 循环插入第二组19列数据到Access表
                    For currentRow = secondGroupStartRow To secondGroupEndRow
                        rstSecondGroup.AddNew
                        ' 示例前3个字段，你需要补充完整19个字段的赋值
                        rstSecondGroup.Fields(0) = xlSheet.Cells(currentRow, "A").Value
                        rstSecondGroup.Fields(1) = xlSheet.Cells(currentRow, "B").Value
                        rstSecondGroup.Fields(2) = xlSheet.Cells(currentRow, "C").Value
                        ' ... 继续补充到第19个字段
                        rstSecondGroup.Fields(18) = xlSheet.Cells(currentRow, "S").Value ' 第19列是S列
                        rstSecondGroup.Update
                    Next currentRow
                End If
                
                ' 关闭当前文件，不保存修改
                xlFile.Close SaveChanges:=False
            Next selectedFile
            
            ' 关闭Excel应用
            xlApp.Quit
            Set xlApp = Nothing
        End If
    End With
    
    ' 清理资源
    rstFirstGroup.Close
    rstSecondGroup.Close
    Set rstFirstGroup = Nothing
    Set rstSecondGroup = Nothing
    Set dbFile = Nothing
    
    MsgBox "所有文件导入完成！", vbInformation
End Sub

关键细节说明 #

1. 文件类型适配：如果是纯CSV文件，用xlSheet = xlFile.Sheets(1)即可；如果是带InputData工作表的Excel文件，替换成xlFile.Sheets("InputData")。
2. 忽略行判断：代码里的Trim(xlSheet.Cells(currentRow, "A").Value) = "此处是需忽略的文本"需要替换成你实际的忽略行内容；如果忽略行没有固定文本，也可以用“该行非空列数远少于19列”来判断。
3. 性能优化：如果数据量很大，循环插入会较慢，你可以把Excel范围转成数组批量插入，或者用CopyFromRecordset方法（需将Excel范围转成ADO记录集）。
4. 错误处理：建议加入On Error GoTo错误处理，避免单个文件出错导致整个批量任务中断。

内容的提问来源于stack exchange，提问作者DanO