vba 将 Excel 批量转换为文本分隔的文件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17141885/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Batch convert Excel to text-delimited files
提问by He Li
Hi I'm facing a problem on dealing with converting Excel spreadsheets to txt files.
嗨，我在处理将 Excel 电子表格转换为 txt 文件时遇到问题。
What I want to do is to create a Macro which can takes all the xls files in one folder and convert them to txt files.
我想要做的是创建一个宏，它可以将一个文件夹中的所有 xls 文件转换为 txt 文件。
The code currently working on
目前正在处理的代码
Sub Combined()
Application.DisplayAlerts = False
Const fPath As String = "C:\Users\A9993846\Desktop\"
Dim sh As Worksheet
Dim sName As String
Dim inputString As String
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
sName = Dir(fPath & "*.xls*")
Do Until sName = ""
With GetObject(fPath & sName)
For Each sh In .Worksheets
With sh
.SaveAs Replace(sName, ".xls*", ".txt"), 42 'UPDATE:
End With
Next sh
.Close True
End With
sName = Dir
Loop
With Application
.Calculation = xlAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
But It's not working as expected, I have 0 knowledge on VB. Anyone willing to give a hand?
但它没有按预期工作，我对 VB 的了解为 0。有人愿意帮忙吗？
回答by
The code below converts all Excel Workbooks (tests file extension for "xlsx") in a given folder into CSV files. File names will be [workbookname][sheetname].csv, ie "foo.xlsx" will get "foo.xlsxSheet1.scv", "foo.xlsxSheet2.scv", etc. In order to run it, create a plain text file, rename it to .vbs and copy-paste the code below. Change path info and run it.
下面的代码将给定文件夹中的所有 Excel 工作簿（测试文件扩展名为“xlsx”）转换为 CSV 文件。文件名将是 [workbookname][sheetname].csv，即“foo.xlsx”将得到“foo.xlsxSheet1.scv”、“foo.xlsxSheet2.scv”等。为了运行它，创建一个纯文本文件，将其重命名为 .vbs 并复制粘贴下面的代码。更改路径信息并运行它。
Option Explicit
Dim oFSO, myFolder
Dim xlCSV
myFolder="C:\your\path\to\excelfiles\"
Set oFSO = CreateObject("Scripting.FileSystemObject")
xlCSV = 6 'Excel CSV format enum
Call ConvertAllExcelFiles(myFolder)
Set oFSO = Nothing
Call MsgBox ("Done!")
Sub ConvertAllExcelFiles(ByVal oFolder)
Dim targetF, oFileList, oFile
Dim oExcel, oWB, oWSH
Set oExcel = CreateObject("Excel.Application")
oExcel.DisplayAlerts = False
Set targetF = oFSO.GetFolder(oFolder)
Set oFileList = targetF.Files
For Each oFile in oFileList
If (Right(oFile.Name, 4) = "xlsx") Then
Set oWB = oExcel.Workbooks.Open(oFile.Path)
For Each oWSH in oWB.Sheets
Call oWSH.SaveAs (oFile.Path & oWSH.Name & ".csv", xlCSV)
Next
Set oWSH = Nothing
Call oWB.Close
Set oWB = Nothing
End If
Next
Call oExcel.Quit
Set oExcel = Nothing
End Sub
You can give better file naming, error handling/etc if needed.
如果需要，您可以提供更好的文件命名、错误处理等。
回答by Ansgar Wiechers
The issue with your code is that you define sPathas a path containing wildcard characters:
您的代码的问题在于您定义sPath为包含通配符的路径：
sName = Dir(fPath & "*.xls*")
and replace only the extension portion (.xls*), but leave the wildcard character before the extension in place:
并仅替换扩展部分 ( .xls*)，但将扩展前的通配符保留在原位：
Replace(sName, ".xls*", ".txt")
This produces the following path:
这将产生以下路径：
C:\Users\A9993846\Desktop\*.txt
which causes the error you observed, because the SaveAsmethod tries to save the spreadsheet to a file with the literal name *.txt, but *is not a valid character for file names.
这会导致您观察到错误，因为该SaveAs方法尝试将电子表格保存到具有文字 name 的文件中*.txt，但*不是文件名的有效字符。
Replace this:
替换这个：
.SaveAs Replace(sName, ".xls*", ".txt"), 42
with this:
有了这个：
Set wb = sh.Parent
basename = Replace(wb.FullName, Mid(wb.Name, InStrRev(wb.Name, ".")), "")
.SaveAs basename & "_" & sh.Name & ".txt", xlUnicodeText
