Question

我有两个代码。我想第二个代码在目录中的所有文件上执行第一个代码。第一个代码就像魅力一样，完全符合我的需要，这就是：

, [A-Z]{2},

第二个代码如下：

Sub STATTRANSFER()
' Transfers all STATS lines
Application.ScreenUpdating = False
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = "STATS"
Set f = Sheets(1)
Set e = Sheets("Stats")
Dim d
Dim j
Dim k
d = 1
j = 1
k = 1
Do Until IsEmpty(f.Range("A" & j))
    If f.Range("A" & j) = "STATS" Then
    e.Rows(d).Value = f.Rows(j).Value
    d = d + 1
    f.Rows(j).Delete
    Else
    j = j + 1
    End If
Loop
Application.ScreenUpdating = True
End Sub

第二个代码成功遍历了我想要的所有文件夹和文档，但是它错误地执行了我的第一个代码。当我单独在工作表上执行第一个代码时，它会创建一个名为STATS的新工作表，然后从第一个工作表中获取A列中包含单词STATS的所有行并将它们复制到新工作表中，然后从中删除STATS行。第一张。

当我使用遍历所有文件夹的第二个代码运行它时，它不会起作用。我可以看到它在我的屏幕上创建了一个名为STATS的工作表，但是当它完成并打开文档时，所有A列中有STATS的行都在第一张纸上，STATS表不再存在，所有A列中没有STATS的数据消失了。所以我不确定问题是什么。

Answer 1

保持你的第一个原样，用这个替换你的第二个子：

Sub MM()

Dim file     As Variant
Dim files    As Variant
Dim WB       As Excel.Workbook

files = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & ActiveWorkbook.Path & "\*.csv"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")

For Each file In files
    Set WB = Workbooks.Open(file)
    STATTRANSFER
    WB.Close True
    Set WB = Nothing
Next

End Sub

Answer 2

就像一句话：你的代码只运行第一级子文件夹。如果要通过所有子级文件夹，则必须使用递归方法，如：

Private Sub test()
    readFileSystem ("C:\Temp\")
End Sub

Private Sub readFileSystem(ByVal pFolder As String)
    Dim oFSO As Object
    Dim oFolder As Object

    ' create FSO
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    ' get start folder
    Set oFolder = oFSO.getFolder(pFolder)

    ' list folder content
    listFolderContent oFolder

    ' destroy FSO
    Set oFolder = Nothing
    Set oFSO = Nothing
End Sub

Private Sub listFolderContent(ByVal pFolder As Object)
    Dim oFile As Object
    Dim oFolder As Object

    ' go thru all sub folders
    For Each oFolder In pFolder.SubFolders
        Debug.Print oFolder.Path
        ' do the recursion to list sub folder content
        listFolderContent oFolder
    Next

    ' list all files in that directory
    For Each oFile In pFolder.Files
        Debug.Print oFile.Path
    Next

    ' destroy all objects
    Set pFolder = Nothing
    Set oFile = Nothing
    Set oFolder = Nothing
End Sub

这只是一个例子，你必须打电话给你的第一个程序当然还是正确的。所以我建议在第一个可以传递工作簿的过程中添加一个参数。

和BTW：始终使用数据类型对变量进行delcare。 Dim j将声明一个VARIANT变量而不是你想要的Interger。

Answer 3

您在第一张工作表中看到了所有STATS，因为您在CSV文件中添加了一个额外的工作表并保存了它。根据定义，CSV文件仅保存并显示1张。对代码的这种修改可以解决您的问题，因为它自称通过子文件夹。试试吧。包括您的STATTRANSFER子。

Public Sub DataProcess()

thisPath = ThisWorkbook.Path
process_folders (thisPath)

End Sub

Sub process_folders(thisPath)

Dim folderPath
Dim filename
Dim newfilename
Dim SavePath
Dim mySubFolder As Object
Dim mainFolder As Object
Dim WB As Workbook
Dim OrigWB As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim name1 As String
Dim name2 As String

Set OrigWB = ThisWorkbook

Set objFSO = CreateObject("Scripting.FileSystemObject")
folderPath = ActiveWorkbook.Path

Set mainFolder = objFSO.GetFolder(folderPath)
folderPath = ActiveWorkbook.Path
filename = Dir(folderPath & "\*.csv")

Do While Len(filename) > 0
    Set WB = Workbooks.Open(folderPath & "\" & filename)
    Call STATTRANSFER

    'save file as Excel file !!!
    ActiveWorkbook.SaveAs _
    filename:=(folderPath & "\" & filename), _
    FileFormat:=xlOpenXMLWorkbook, _
    CreateBackup:=False
    ActiveWorkbook.Close (False)

    filename = Dir

Loop

    'now with each subfolder
    For Each subfolder In mainFolder.SubFolders
        process_folders (subfolder)
    Next

End Sub

Answer 4

问题是你只能用一张纸保存.csv。现在代码看起来像这样。

Sub NewDataProcess()

Dim file     As Variant
Dim files    As Variant
Dim wb       As Excel.Workbook

files = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & ActiveWorkbook.Path & "\*.csv"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")

For Each file In files
    Set wb = Workbooks.Open(file)
    Call STATTRANSFER(wb)
    newfilename = Replace(file, ".csv", ".xlsm")
    wb.SaveAs filename:=newfilename, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    wb.Close SaveChanges:=False
    Set wb = Nothing
Next

End Sub

现在我需要一种方法来删除旧文件，如果有人可以提供帮助。我根本不想要CSV文件

循环遍历文件夹中的所有文件

4 个答案: