Question

我正在努力：

从特定文件夹中打开每日生成的CSV文件（包含更改文件名），将内容粘贴到其他Excel工作簿中，然后将CSV文件移动到原始文件夹中的子文件夹。
< / LI>
过滤复制的数据，将过滤后的数据提取到单独的工作表中，这将成为一个大型数据表。
重复此过程，直到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的{{1}}以下。

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

Sub Master

请将变量类型"Field1", "Field2A, Field2B", "Field3", "Field4A""FieldB"替换为Integer。 Long指定一个16位整数，需要在32位和64位计算机上进行特殊（慢速）处理。

请在循环外移动以下内容，使其仅执行一次：

Integer

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

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

1 个答案: