如何将每个单独的表保存为txt文件

时间:2021-02-08 20:56:49

I have a code that creates sheets in a certain format that I then want to save as text files. I have been using Sheet.SaveAs and then naming the file differently. Is there a more robust way of saving files and moving them around? My current code runs as follows:

我有一个以某种格式创建表单的代码,然后我想将其保存为文本文件。我一直在用床单。保存,然后以不同的方式命名文件。是否有一种更健壮的方式来保存和移动文件?我目前的代码如下:

    OldPath = ThisWorkbook.Path & "\"     ' current path to this workbook
    OldFile = OldPath & ShtName & ".txt"  ' location of file upon creation

    NewPath = OldPath & FldName & "\"     ' path for the folder where file will be moved
    NewFile = NewPath & ShtName & ".txt"  ' location of file after moving
                                                                                             '[3] CREATE INPUT FILES
    ThisWorkbook.Sheets(ShtName).SaveAs OldFile, FileFormat:=xlTextWindows
    ThisWorkbook.SaveAs OldPath & ThisFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled

    If Len(Dir(NewPath, vbDirectory)) <> 0 And NewPath <> "" Then  'MOVE FILES TO A FOLDER
    Else
        MkDir NewPath  ' create folder for input files to be moved if not yet created
    End If

    If Len(Dir(NewFile)) <> 0 Then  
    ' delete an old version of file if it is already in folder
        SetAttr NewFile, vbNormal
        Kill NewFile
    End If

    Name OldFile As NewFile 

This method feels cumbersome but I don't want to have to resort to using Shell, as I feel that would be less robust, unless someone recommends that instead.

这种方法感觉很麻烦,但我不想使用Shell,因为我觉得它不那么健壮,除非有人建议这样做。

1 个解决方案

#1


1  

You can use a Generic Text printer, and the PrintOut method to achieve this

您可以使用通用文本打印机和打印输出方法来实现这一点。

First, if you havn't already, add a Generic Text Printer

首先,如果还没有,添加一个通用文本打印机

  1. From Add Printer dialog, select File port
  2. 在“添加打印机”对话框中,选择“文件端口”
  3. Select Generic then Generic / Text Only
  4. 选择泛型然后泛型/文本
  5. Name it as you wish
  6. 随你的便

This code sends each worksheet to this printer

此代码将每个工作表发送到此打印机。

Sub SaveWorkbookAsText(wb As Workbook, Optional FldName As String = vbNullString)
    Dim NewPath As String
    Dim GenericTextOnlyPrinter As String
    Dim ws As Worksheet

    '<~~~ Change this string to match your Generic Text Only Printer Name
    GenericTextOnlyPrinter = "Text Only (File)"

    NewPath = ThisWorkbook.Path & Application.PathSeparator

    If FldName <> vbNullString Then
        NewPath = NewPath & FldName
        If Right$(NewPath, 1) <> Application.PathSeparator Then
            NewPath = NewPath & Application.PathSeparator
        End If
    End If

    For Each ws In wb.Worksheets
        ws.PrintOut _
          ActivePrinter:=GenericTextOnlyPrinter, _
          PrintToFile:=True, _
          PrToFileName:=NewPath & ws.Name & ".txt", _
          IgnorePrintAreas:=True
    Next
End Sub

Alternatively, without depending on a printer, generate the file in code

或者,不依赖于打印机,以代码生成文件

Sub SaveWorkbookAsText(wb As Workbook, Optional FldName As String = vbNullString)
    Dim NewPath As String
    Dim ws As Worksheet
    Dim dat As Variant
    Dim rw As Long, cl As Long
    Dim FileNum As Integer
    Dim Line As String

    NewPath = ThisWorkbook.Path & Application.PathSeparator

    If FldName <> vbNullString Then
        NewPath = NewPath & FldName
        If Right$(NewPath, 1) <> Application.PathSeparator Then
            NewPath = NewPath & Application.PathSeparator
        End If
    End If

    For Each ws In wb.Worksheets
        FileNum = FreeFile
        Open NewPath & ws.Name & ".txt" For Output As #FileNum    ' creates the file

        dat = ws.UsedRange.Value
        ' in case the sheet contains only 0 or 1 cells
        If TypeName(dat) <> "Variant()" Then
            dat = ws.UsedRange.Resize(, 2)
        End If

        For rw = 1 To UBound(dat, 1)
            Line = vbNullString
            For cl = 1 To UBound(dat, 2) - 1
                Line = Line & dat(rw, cl) & vbTab
            Next
            Print #FileNum, Line & dat(rw, cl)
        Next
        Close #FileNum
    Next
End Sub

#1


1  

You can use a Generic Text printer, and the PrintOut method to achieve this

您可以使用通用文本打印机和打印输出方法来实现这一点。

First, if you havn't already, add a Generic Text Printer

首先,如果还没有,添加一个通用文本打印机

  1. From Add Printer dialog, select File port
  2. 在“添加打印机”对话框中,选择“文件端口”
  3. Select Generic then Generic / Text Only
  4. 选择泛型然后泛型/文本
  5. Name it as you wish
  6. 随你的便

This code sends each worksheet to this printer

此代码将每个工作表发送到此打印机。

Sub SaveWorkbookAsText(wb As Workbook, Optional FldName As String = vbNullString)
    Dim NewPath As String
    Dim GenericTextOnlyPrinter As String
    Dim ws As Worksheet

    '<~~~ Change this string to match your Generic Text Only Printer Name
    GenericTextOnlyPrinter = "Text Only (File)"

    NewPath = ThisWorkbook.Path & Application.PathSeparator

    If FldName <> vbNullString Then
        NewPath = NewPath & FldName
        If Right$(NewPath, 1) <> Application.PathSeparator Then
            NewPath = NewPath & Application.PathSeparator
        End If
    End If

    For Each ws In wb.Worksheets
        ws.PrintOut _
          ActivePrinter:=GenericTextOnlyPrinter, _
          PrintToFile:=True, _
          PrToFileName:=NewPath & ws.Name & ".txt", _
          IgnorePrintAreas:=True
    Next
End Sub

Alternatively, without depending on a printer, generate the file in code

或者,不依赖于打印机,以代码生成文件

Sub SaveWorkbookAsText(wb As Workbook, Optional FldName As String = vbNullString)
    Dim NewPath As String
    Dim ws As Worksheet
    Dim dat As Variant
    Dim rw As Long, cl As Long
    Dim FileNum As Integer
    Dim Line As String

    NewPath = ThisWorkbook.Path & Application.PathSeparator

    If FldName <> vbNullString Then
        NewPath = NewPath & FldName
        If Right$(NewPath, 1) <> Application.PathSeparator Then
            NewPath = NewPath & Application.PathSeparator
        End If
    End If

    For Each ws In wb.Worksheets
        FileNum = FreeFile
        Open NewPath & ws.Name & ".txt" For Output As #FileNum    ' creates the file

        dat = ws.UsedRange.Value
        ' in case the sheet contains only 0 or 1 cells
        If TypeName(dat) <> "Variant()" Then
            dat = ws.UsedRange.Resize(, 2)
        End If

        For rw = 1 To UBound(dat, 1)
            Line = vbNullString
            For cl = 1 To UBound(dat, 2) - 1
                Line = Line & dat(rw, cl) & vbTab
            Next
            Print #FileNum, Line & dat(rw, cl)
        Next
        Close #FileNum
    Next
End Sub