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

时间:2015-07-31 08:23:23

标签: excel-vba csv import vba excel

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

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

每次单击按钮而不是添加新工作表时,如何使导入代码覆盖?

THX!

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

2 个答案:

答案 0 :(得分:1)

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

从文件创建查询,指向CSV文件并将其加载到工作表。

为每个CSV文件/工作表冲洗并重复。

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

如果它们具有相同的结构,也可以将所有CSV文件合并为一个工作表。您甚至不需要知道CSV文件的名称。您可以加载特定文件夹中的所有CSV文件,并使用Power Query将它们合并到一个工作表中。 Mike Girvin(ExcelIsFun)有关于here的精彩视频。

答案 1 :(得分:1)

这个解决方案有2个部分:找出是否有纸张并覆盖它;并查明文件是否已更改。

你的第一点问题是,你真的没有任何东西来质疑这张表是否存在。您可以找到工作表使用的名称:

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

然后,您可以遍历所有工作表以查看是否已存在:

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变量。这样我们就可以跟踪现有工作表的位置,以便我们可以将新版本推送到Sheets中的相同位置。

接下来,我们可以打开新工作簿并将其分配给mybook参考。如果工作表已经存在,我们应该将其删除,如果它不存在,我们希望将新工作表放在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)

然后我们继续将工作表复制到现有工作簿中,重命名新工作表并关闭而不保存:

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

如果自上次修改工作簿以来.csv文件已被修改,则只会发生上述所有情况。要弄清楚使用字符串作为文件路径是有点棘手,但如果使用FileSystemObject s则更直接。
FileSystemObject的行为类似于windows文件夹层次结构并提供{{1具有文件系统属性的{}和File个对象。以,例如下面的代码:

Folder

此代码确定上次保存工作簿的时间,根据.csv文件的路径创建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 对象,然后依次遍历每个文件。如果发现文件的类型为Folder,并且自上次保存工作簿以来该文件已被修改,则会对其感兴趣。

实质上,整个例程可以组合成以下代码:

CSV File
相关问题