将多个 CSV 文件自动导入和更新到 Excel 工作簿

Question

我有一个包含多个 CSV 文件的文件夹，还有另一个包含 Excel 工作簿的文件夹。我想通过单击一个按钮将工作簿中的所有 CSV 文件导入单独的工作表（fx 3.csv 将有工作表名称“3”等）。这些 CSV 文件经常更新，但并不总是在同一天更新。我希望导入代码也更新任何已更新的 CSV 文件。我假设每次导入所有文件时都会隐式完成此操作。

下面的代码可以解决这个问题..差不多。问题是每当我单击按钮时，它都不会覆盖现有的工作表。它添加了新的床单。假设我上传（第一次）。工作簿中的工作表称为 city1.csv、city2.csv 等。第二次我运行代码时，它添加了另一个范围的工作表 city1、city2 等。第三次 city1( 1), city2(2) 等

如何让导入代码在每次单击按钮时都被覆盖而不是添加新工作表？

谢谢！

Sub import_test3()
 Dim MyPath As String
 Dim FilesInPath As String
 Dim MyFiles() As String
 Dim SourceRcount As Long
 Dim Fnum As Long
 Dim mybook As Workbook
 Dim basebook As Workbook

 MyPath = "\filepath\folder"

 If Right(MyPath, 1) <> "\" Then
 MyPath = MyPath & "\"
 End If

 FilesInPath = Dir(MyPath & "*.csv")
 If FilesInPath = "" Then
 MsgBox "No CSV files found"
 Exit Sub
 End If

 On Error GoTo CleanUp

 Application.ScreenUpdating = False
 Set basebook = ThisWorkbook

 Fnum = 0
 Do While FilesInPath <> ""
 Fnum = Fnum + 1
 ReDim Preserve MyFiles(1 To Fnum)
 MyFiles(Fnum) = FilesInPath
 FilesInPath = Dir()
 Loop

 If Fnum > 0 Then
 For Fnum = LBound(MyFiles) To UBound(MyFiles)
 Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
 mybook.Worksheets(1).Copy after:= _
 basebook.Sheets(basebook.Sheets.Count)

 On Error Resume Next
 ActiveSheet.Name = mybook.Name
 On Error GoTo 0


 mybook.Close savechanges:=False
 Next Fnum
 End If
 CleanUp:
 Application.ScreenUpdating = True
 End Sub

Answer 1

您可能需要考虑使用 Power Query 而不是 VBA。 Power Query 可从 Microsoft 免费下载 Excel 2010 和 2013。

从文件创建查询，指向 CSV 文件并将其加载到作品sheet。

冲洗并重复每个 CSV file/worksheet。

设置打开文件时刷新的数据连接。

如果结构相同，也可以将所有 CSV 文件合并为一个 sheet。您甚至不需要知道 CSV 文件的名称。您可以加载特定文件夹中的所有 CSV 文件，然后使用 Power Query 将它们合并为一个 sheet。 Mike Girvin (ExcelIsFun) 有一个很棒的视频 here。

Answer 2

这个解决方案有两个部分：找出 sheet 是否存在并覆盖它；并查明文件是否已更改。

您对第一点的问题是，您实际上没有任何东西可以查询 sheet 是否存在。您可以使用以下方法找到作品 sheet 的名称：

Dim sheetName as String
sheetName = Left(MyFiles(Fnum), InStr(MyFiles(Fnum), ".") - 1)

然后您可以遍历所有 sheet 以查看是否已经存在：

Dim sheetExists As Boolean
Dim ws As Worksheet
Dim sheetCounter As Integer
sheetExists = False
sheetCounter = 0
For Each ws In basebook.Worksheets
    sheetCounter = sheetCounter + 1
    If ws.Name = sheetName Then
        sheetExists = True
    End If
Next ws

注意 sheetCounter 变量。这让我们可以跟踪现有 sheet 的位置，以便我们可以将新版本推送到 Sheets.

中的同一位置

接下来我们可以打开我们的新工作簿并将其分配给 mybook 引用。如果 sheet 已经存在，我们应该删除它，如果它不存在，我们想把新的 sheet 放到 Sheets 集合的后面。

Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
If sheetExists Then
    basebook.Sheets(sheetName).Delete
Else
    sheetCounter = basebook.Sheets.Count
End If
mybook.Worksheets(1).Copy after:= basebook.Sheets(sheetCounter)

然后我们继续将 sheet 复制到现有工作簿中，重命名新的 sheet 并在不保存的情况下关闭：

basebook.Sheets(sheetCounter).Name = mybook.Name
mybook.Close savechanges:=False

只有当 .csv 文件自上次修改工作簿后被修改时，才会发生上述所有情况。弄清楚使用字符串作为文件路径有点棘手，但如果使用 FileSystemObjects 会更简单。
FileSystemObjects 的行为类似于 windows 文件夹层次结构并为 File 和 Folder 对象提供文件系统属性。以下面的代码为例：

Dim fso As New FileSystemObject
Dim fld As Folder
Dim f As File

Dim path As String
path = "C:\Test\"

Dim lastModified As Date
lastModified = FileDateTime(ThisWorkbook.path)
Set fld = fso.GetFolder(path)
For Each f In fld.Files
    If f.Type = "CSV File" Then
        If f.DateLastModified - lastModified > 0 Then
            'We have a .csv file that was modified after this
            'workbook was saved so we should copy it into here 
        End If
    End If
Next f

此代码确定上次保存工作簿的时间，根据 .csv 文件的路径创建一个 Folder 对象，然后依次循环遍历每个文件。如果发现该文件的类型为 CSV File，并且自上次保存工作簿以来对其进行了修改，那么它很重要。

本质上，整个例程可以组合成下面的代码：

Sub ReadUpdatedFiles()

Application.ScreenUpdating = False

Dim fso As New FileSystemObject
Dim fld As Folder
Dim f As File

Dim MyPath As String
MyPath = "\filepath\folder"

Dim lastModified As Date
lastModified = FileDateTime(ThisWorkbook.path)

Dim sheetExists As Boolean
Dim ws As Worksheet
Dim sheetName As String
Dim mybook As Workbook
Dim sheetCounter As Integer

Set fld = fso.GetFolder(MyPath)
For Each f In fld.Files
    If f.Type = "CSV File" Then
        If f.DateLastModified - lastModified > 0 Then
            sheetExists = False
            sheetName = Left(f.Name, InStr(f.Name, ".") - 1)
            sheetCounter = 0
            For Each ws In Worksheets
                sheetCounter = sheetCounter + 1
                If ws.Name = sheetName Then
                    sheetExists = True
                End If
            Next ws

            Set mybook = Workbooks.Open(f.path)
            If sheetExists Then
                basebook.Sheets(sheetName).Delete
            Else
                sheetCounter = basebook.Sheets.Count
            End If
            mybook.Worksheets(1).Copy after:=ThisWorkbook.Sheets(sheetCounter)
        End If
    End If
Next f

Application.ScreenUpdating = True

End Sub

将多个 CSV 文件自动导入和更新到 Excel 工作簿

Import and update several CSV files automatically into Excel workbook

csv

import

excel

vba