Question

似乎Workbook.SaveAs method不支持附加到文件（否则，我可以对common solutions之一进行略微修改）。

我知道我可以使用Open语句和write line by line，但是我更喜欢更高级的解决方案。

Answer 1

基于this answer，这是一个以vbTab作为分隔符的逐行解决方案：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim wsSheet As Worksheet
    Dim nFileNum As Integer
    Dim txtPath As String
    Dim FirstSheet As Boolean

    Application.ScreenUpdating = False

    txtPath = ActiveWorkbook.FullName
    txtPath = Replace(txtPath, "xlsm", "txt")
    nFileNum = FreeFile

    FirstSheet = True
    For Each wsSheet In Worksheets
        If FirstSheet = True Then
            ' Overwrite
            Open txtPath For Output As #nFileNum
        Else
            ' Append
            Open txtPath For Append As #nFileNum
        End If

        wsSheet.Activate
        ExportToTextFile CStr(nFileNum), vbTab, False, Not (FirstSheet)

        Close #nFileNum

        FirstSheet = False

    Next wsSheet

    Application.ScreenUpdating = True

End Sub


Public Sub ExportToTextFile(nFileNum As Integer, _
                            Sep As String, SelectionOnly As Boolean, _
                            SkipHeader As Boolean)

    Dim WholeLine As String
    Dim RowNdx As Long
    Dim ColNdx As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    Dim StartCol As Integer
    Dim EndCol As Integer
    Dim CellValue As String

    On Error GoTo EndMacro:

    If SelectionOnly = True Then
        With Selection
            StartRow = .Cells(1).Row
            StartCol = .Cells(1).Column
            EndRow = .Cells(.Cells.Count).Row
            EndCol = .Cells(.Cells.Count).Column
        End With
    Else
        With ActiveSheet.UsedRange
            StartRow = .Cells(1).Row
            StartCol = .Cells(1).Column
            EndRow = .Cells(.Cells.Count).Row
            EndCol = .Cells(.Cells.Count).Column
        End With
    End If

    If SkipHeader = True Then
        StartRow = StartRow + 1
    End If

    For RowNdx = StartRow To EndRow
        WholeLine = ""
        For ColNdx = StartCol To EndCol
            If Cells(RowNdx, ColNdx).Value = "" Then
                CellValue = ""
            Else
                CellValue = Cells(RowNdx, ColNdx).Value
            End If
            WholeLine = WholeLine & CellValue & Sep
        Next ColNdx
        WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
        Print #nFileNum, WholeLine
    Next RowNdx

EndMacro:
    On Error GoTo 0

End Sub

如何将工作簿中的所有图纸导出到单个文本文件？

1 个答案: