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

我有一个代码，创build一个特定格式的表，然后我想保存为文本文件。 我一直在使用Sheet.SaveAs，然后以不同的方式命名文件。 有更强大的方式来保存文件并移动它们吗？ 我现在的代码运行如下：

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 

这种方法感觉很麻烦，但我不想诉诸使用壳牌，因为我觉得这样做不那么强大，除非有人推荐。

Answer 1

您可以使用通用文本打印机，并使用PrintOut方法来实现此目的

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

1. 在Add Printer对话框中，selectFile端口
2. selectGeneric然后selectGeneric Generic / Text Only
3. 按你的意思命名

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

 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 

---

或者，不依赖打印机，用代码生成文件

 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