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

Question

我正在尝试：

• 从特定文件夹打开每天生成的 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

Answer 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*"

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