将 CSV 文件的内容复制到现有工作簿，然后移动 CSV

Posted 2023-04-19

【中文标题】将 CSV 文件的内容复制到现有工作簿，然后移动 CSV

【英文标题】：Copy contents of CSV files to an exisiting workbook then move CSV

【发布时间】：2016-01-14 11:06:37

【问题描述】：

我正在尝试：

从特定文件夹打开每天生成的 CSV 文件（文件名更改），将内容粘贴到不同的 Excel 工作簿中，然后将 CSV 文件移动到原始文件夹中的子文件夹中。

对复制的数据进行过滤，将过滤后的数据提取到单独的工作表中，这将成为一个大数据表。

重复此过程，直到 CSV 文件所在的文件夹中没有任何文件。

我编写了一个宏来打开一个 CSV 文件，（如果您指定了确切的文件名）然后将内容复制到 Excel 工作簿。

我还编写了一个宏，可以将文件夹中的所有 CSV 文件移动到子文件夹中。

我遇到的问题是将两者结合起来。

Sub Master()

'Open File

Dim rDest As Range
Set rDest = ThisWorkbook.Sheets("Paste Here").Range("A1:Z300")
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\Users\danielt\Desktop\CSV Files"
MyFile = Dir(MyFolder & "\*.csv")
Do While MyFile <> ""
Workbooks.Open filename:=MyFolder & "\" & MyFile

'Copy Contents

Sheets(1).Select
Sheets(1).Range("A1:Z300").Select
Selection.Copy

'Paste Contents into "Paste here" sheet

rDest.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.DisplayAlerts = False

'Close opened file

ActiveWorkbook.Close SaveChanges:=False

'Move to new folder named "harvested"

Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim FNames As String

FromPath = "C:\Users\danielt\Desktop\CSV Files"
ToPath = "C:\Users\danielt\Desktop\CSV Files\Harvested"
FileExt = "*.csv*"

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

'FNames = Dir(FromPath & FileExt)
'If Len(FNames) = 0 Then
'MsgBox "No files in " & FromPath
'Exit Sub

End If
Set FSO = CreateObject("scripting.filesystemobject")
  'FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath
FSO.MoveFile Source:=FromPath & FileExt, Destination:=ToPath

'Apply filter and copy & paste to report

'The filter is very long so I haven't included this. (But it runs fine)

'Transpose data from "report" to "raswcsvdata"

Sheets("Report").Select
Range("C3:C33").Select
Selection.Copy
Sheets("RawCSVdata").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

'Clear report & paste here

Public Function GetValueFromDelimString(sPackedValue As String, nPos As Long, Optional sDelim As String)

Dim sElements() As String

sElements() = Split(sPackedValue, sDelim)
If UBound(sElements) < nPos Then
GetValueFromDelimString = ""
Else
GetValueFromDelimString = sElements(nPos)
End If

End Function


Function FindN(sFindWhat As String, sInputString As String, N As Integer) As Integer
Dim J As Integer
Application.Volatile
FindN = 0
For J = 1 To N
FindN = InStr(FindN + 1, sInputString, sFindWhat)
If FindN = 0 Then Exit For
Next
End Function

' Open next file

MyFile = Dir
Loop

End Sub

【问题讨论】：

在部分代码中使用Dir 而在另一部分中使用FileSystemObject 似乎有点奇怪。我会在整个过程中使用FSO，因为它还具有循环文件的能力。整个代码听起来像是一个大循环，您在其中循环浏览文件夹中的 csv 文件，处理它们，然后移动它们。它们部分的过程可以移动到一个 sub，它采用文件名或打开的文件本身，以及目标工作簿作为参数。这样可以防止整个程序的主循环变得过大。

感谢您的快速回复。我想我应该补充一点，我是 VBA 的新手，因为我以前从未使用过它。因此，大部分代码都是从各种论坛中提取的，以使其启动并运行。我可以简单地将 Dir 零件转为 FSO 吗？还是比这更复杂？

【参考方案1】：

这不是一个完整的答案，因为我对您的意图不够清楚。不过，我想我可以帮助您继续前进。

我认为 John Coleman 对 Dir 和 File System Object 的评论是正确的，但没有得到充分解释。 Dir 是旧技术。我怀疑对于大多数编程语言，它会被“贬低”并计划从规范中删除。 MS 不会为 Excel VBA 做这种事情。它引入了具有更多功能的更新的File System Object。我将 FSO 归类为更难学习正确使用，但一旦完全理解，就会更方便。 FSO 会做Dir 会做的所有事情，但反之则不然。 John 建议，如果您要使用某些 FSO 功能，则不要同时使用它所替代的“过时”语句和方法。但是，不必删除Dir。我被教导：“让你的代码工作，然后让它变得更好更快、更优雅等等。”我认为你有比使用两种技术更重要的问题。

请缩进您的代码。在每个Sub … End Sub、If … End If、For … Next 等中，跨入几个空格。这使您的代码更易于阅读，并且更容易发现嵌套错误。

您的代码将不会执行。在Sub Master … End Sub 中，您有两个函数：GetValueFromDelimString 和FindN。您不能以这种方式嵌套。将这些函数移到End Sub 下方，用于Sub Master。

您的函数似乎旨在帮助解析 CSV 文件的行。它们看起来不够强大，无法实现这一目标。你将如何使用这些函数来解析这一行？

"Field1", "Field2A, Field2B", "Field3", "Field4A""FieldB"

请将变量类型Integer 替换为Long。 Integer 指定一个 16 位整数，需要在 32 位和 64 位计算机上进行特殊（即缓慢）处理。

请将以下内容移出循环，使其只执行一次：

Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileExt As String
Dim FNames As String

FromPath = "C:\Users\danielt\Desktop\CSV Files"
ToPath = "C:\Users\danielt\Desktop\CSV Files\Harvested"
FileExt = "*.csv*"

以上修复了一些错误。请尝试我建议的更正。这些更正是否解决了您的问题？如果没有，我会提出进一步的建议。