循环浏览工作簿文件夹，并使用Excel VBA将所有工作表导出为制表符分隔的文本

Question

I pieced together an Excel VBA script that writes all worksheets in an open workbook to separate, tab-delimited files (is this still a "macro"? I'm learning this in an Excel vacuum). It works well on one workbook at a time. Here it is.

Sub exportSheetsToText()
    Dim sWb As String
    Dim sFile As String
    Dim oSheet As Worksheet

    sWb = Left(ActiveWorkbook.FullName, InStr(ActiveWorkbook.FullName, ".") - 1)

    For Each oSheet In Worksheets
        oSheet.Copy
        sFile = sWb & "-" & oSheet.Name & ".txt"
        ActiveWorkbook.SaveAs fileName:=sFile, FileFormat:=xlText
        ActiveWorkbook.Close SaveChanges:=False
        Next oSheet
End Sub

I would like to scale this up so that I can apply this macro to a folder of workbooks. I wrote what I thought would loop over every workbook that satisfies the filter, but it doesn't write any of the .txt files. Here it is.

Sub exportsSheetsToTextForAll()

    Dim sPath As String
    Dim sWildcard As String
    Dim sMacro As String
    Dim oWb As Workbook
    Dim oPersWb As Workbook

    Application.AutomationSecurity = msoAutomationSecurityForceDisable
    Set oPersWb = Workbooks("PERSONAL.XLSB")
    sMacro = "'" & oPersWb.Name & "'" & "!exportSheetsToText()"
    sPath = "C:\Users\richard\Documents\Research\Data\Excel\Datastream - payout"
    sWildcard = "New*.xlsx"
    sFile = Dir(sPath & "\" & sWildcard)


    Do While Len(sFile) > 0
        Workbooks.Open Filename:=sPath & "\" & sFile
        Application.Run sMacro
        ActiveWorkbook.Close SaveChanges:=False
        sFile = Dir
    Loop

End Sub

It loops through all of my test files, but I don't see any effects (ie, no .txt files and no errors).

Eventually I will run this on very large workbooks with macros, so it is important to disable the macros (I don't have the macros locally, they're on a dedicated data machine) and close one large workbook before opening the next.

Any ideas? Thanks!

Answer 1

@Siddarth's idea of passing an argument to exportSheetsToText() was the key. As well I had an error with macro name passed to Application.Run . The following works and is much cleaner.

Sub exportsSheetsToTextForAll()

    Application.AutomationSecurity = msoAutomationSecurityForceDisable

    excelFiles = Dir(ThisWorkbook.Path & "\" & "New*.xlsx")
    fromPath = ThisWorkbook.Path

    Do While Len(excelFiles) > 0
        Debug.Print Files
        Set oWb = Workbooks.Open(Filename:=fromPath & "\" & excelFiles)
        Application.Run "exportSheetsToText", oWb
        oWb.Close SaveChanges:=False
        excelFiles = Dir
    Loop

End Sub

Sub exportSheetsToText(iWb As Workbook)

    For Each ws In iWb.Worksheets
        ws.Copy
        Set wb = ActiveWorkbook
        textFile = Left(iWb.FullName, InStr(iWb.FullName, ".") - 1) & "-" & ws.Name & ".txt"
        wb.SaveAs Filename:=textFile, FileFormat:=xlText
        wb.Close SaveChanges:=False
    Next ws
End Sub