簡體   English   中英

循環瀏覽工作簿文件夾,並使用Excel VBA將所有工作表導出為制表符分隔的文本

[英]Loop over folder of workbooks and export all sheets to tab-delimited text with Excel VBA

我拼湊了一個Excel VBA腳本,該腳本將所有工作表寫在一個打開的工作簿中,以分隔制表符分隔的文件(這仍然是一個“宏”嗎?我正在Excel吸塵器中學習它)。 一次可以在一個工作簿上很好地工作。 這里是。

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

我想擴大規模,以便可以將此宏應用於工作簿文件夾。 我寫了我認為會遍歷所有滿足篩選條件的工作簿的內容,但是它沒有寫任何.txt文件。 這里是。

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

它循環遍歷我所有的測試文件,但是我看不到任何影響(即沒有.txt文件且沒有錯誤)。

最終,我將在帶有宏的非常大的工作簿上運行此命令,因此禁用宏(我本地沒有宏,它們在專用數據機上)並關閉一個大工作簿,然后再打開下一個工作簿,這一點很重要。

有任何想法嗎? 謝謝!

exportSheetsToText()將參數傳遞給exportSheetsToText()的想法是關鍵。 同樣,我在將宏名稱傳遞給Application.Run出錯。 以下工作原理更清潔。

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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM