批量将Excel转换为文本分隔文件
嗨,我在处理将Excel电子表格转换为txt文件时遇到了一个问题 我想做的是创建一个宏,它可以将所有xls文件放在一个文件夹中,并将它们转换为txt文件 当前正在处理的代码批量将Excel转换为文本分隔文件,excel,vba,Excel,Vba,嗨,我在处理将Excel电子表格转换为txt文件时遇到了一个问题 我想做的是创建一个宏,它可以将所有xls文件放在一个文件夹中,并将它们转换为txt文件 当前正在处理的代码 Sub Combined() Application.DisplayAlerts = False Const fPath As String = "C:\Users\A9993846\Desktop\" Dim sh As Worksheet Dim sName As String Dim input
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
但它并没有像预期的那样工作,我对VB一无所知。有人愿意帮忙吗?下面的代码将给定文件夹中的所有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
如果需要,您可以提供更好的文件命名、错误处理等功能。下面的代码将给定文件夹中的所有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
如果需要,您可以提供更好的文件命名、错误处理等功能。代码的问题在于您将
sPath
定义为包含通配符的路径:
sName = Dir(fPath & "*.xls*")
并仅替换扩展部分(.xls*
),但保留扩展部分前的通配符:
Replace(sName, ".xls*", ".txt")
这将生成以下路径:
C:\Users\A9993846\Desktop\*.txt
这会导致您观察到的错误,因为SaveAs
方法尝试将电子表格保存到具有文字名称*.txt
的文件中,但*
不是文件名的有效字符
替换此项:
.SaveAs Replace(sName, ".xls*", ".txt"), 42
为此:
Set wb = sh.Parent
basename = Replace(wb.FullName, Mid(wb.Name, InStrRev(wb.Name, ".")), "")
.SaveAs basename & "_" & sh.Name & ".txt", xlUnicodeText
代码的问题在于将
sPath
定义为包含通配符的路径:
sName = Dir(fPath & "*.xls*")
并仅替换扩展部分(.xls*
),但保留扩展部分前的通配符:
Replace(sName, ".xls*", ".txt")
这将生成以下路径:
C:\Users\A9993846\Desktop\*.txt
这会导致您观察到的错误,因为SaveAs
方法尝试将电子表格保存到具有文字名称*.txt
的文件中,但*
不是文件名的有效字符
替换此项:
.SaveAs Replace(sName, ".xls*", ".txt"), 42
为此:
Set wb = sh.Parent
basename = Replace(wb.FullName, Mid(wb.Name, InStrRev(wb.Name, ".")), "")
.SaveAs basename & "_" & sh.Name & ".txt", xlUnicodeText
它究竟是如何“不按预期工作”的?您得到了什么结果,以及它们与您期望的结果有何不同?错误,行.SaveAs Replace(sName,“.xls*”,“.txt”)、42“UPDATE:导致运行时错误“1004”。用sh.SaveAs ePath&sName+sh.Name+“.txt”、xlTextWindows替换后,一切正常。但我真的很想得到你的帮助!顺便说一句,ePath是我希望将定义为Const ePath的文件放置为String=“C:\Users\A9993846\Desktop\Test\”@HeLi为您添加了代码的新路径。与1004相关,您的路径信息可能是错误的,这就是为什么.SaveAs不起作用的原因。如果您想保留代码并按“您的方式”运行,请尝试将.SaveAs替换为MsgBox,以查看路径信息是否正确(不会是:)它到底是如何“无法按预期工作”的?您得到了什么结果,以及它们与您期望的结果有何不同?错误,行.SaveAs Replace(sName,“.xls*”,“.txt”)、42“UPDATE:导致运行时错误“1004”。用sh.SaveAs ePath&sName+sh.Name+“.txt”、xlTextWindows替换后,一切正常。但我真的很想得到你的帮助!顺便说一句,ePath是我希望将定义为Const ePath的文件放置为String=“C:\Users\A9993846\Desktop\Test\”@HeLi为您添加了代码的新路径。与1004相关,您的路径信息可能是错误的,这就是为什么.SaveAs不起作用的原因。如果您想保留您的代码并按“您的方式”运行,请尝试将.SaveAs替换为MsgBox,以查看路径信息是否正确(不会是:)您好,您的方式也是处理此类问题的非常方便的方式,谢谢您的帮助。这不是VBA。别再把VBScript和VBA混为一谈了,这怎么可能是公认的答案呢?嗨,马克,你的方法也是处理此类问题的一种非常方便的方法,谢谢你的帮助。这不是VBA。停止混合VBScript和VBA,这怎么可能是公认的答案?嗨,Ansgar,谢谢你的回复,我尝试了,但出现了新的错误:sh.FullName给了我一个编译错误:方法或数据成员找不到我的错误
sh
是对工作表的引用,因此需要首先获取对父对象(工作簿)的引用。请参阅更新的答案。嗨,安斯加,我认为您的解决方案只保存当前工作簿,但丢失了单个工作表。这违背了我以不同格式保存每张工作表的目的。但无论如何,谢谢它没有漏掉表单,而是用下一张表单重写了每个保存的表单,这样就只剩下最后一张表单了。通过将工作表名称附加到工作簿名称来修复。嗨,Ansgar谢谢你的回复,我尝试了,但出现了新的错误:sh.FullName给了我一个编译错误:方法或数据成员找不到我的错误sh
是对工作表的引用,因此需要首先获取对父对象(工作簿)的引用。请参阅更新的答案。嗨,安斯加,我认为您的解决方案只保存当前工作簿,但丢失了单个工作表。这违背了我以不同格式保存每张工作表的目的。但无论如何,谢谢它没有漏掉表单,而是用下一张表单重写了每个保存的表单,这样就只剩下最后一张表单了。通过将工作表名称附加到工作簿名称来修复此问题。