将带分隔符txt文件另存为xls格式
'功能：批量另存为一个目录下的XLS文件
'srcPath 源目录
'desPath 目标目录
'---------------------------------------
Sub SaveAsExcelInPath(srcPath As String, desPath As String)
If Right(srcPath, 1) <> "/" Then
srcPath = srcPath + "/"
End If
If Right(desPath, 1) <> "/" Then
desPath = desPath + "/"
End If
ChDir srcPath
Dim f_name$
f_name = Dir(srcPath + "*.xls")
While f_name <> ""
SaveAsExcel srcPath, desPath, f_name
f_name = Dir()
Wend
End Sub
'---------------------------------------
'功能：另存为一个XLS文件
'srcPath 源目录
'desPath 目标目录
'FileName 文件名
'---------------------------------------
Sub SaveAsExcel(srcPath As String, desPath As String, FileName As String)
If Right(srcPath, 1) <> "/" Then
srcPath = srcPath + "/"
End If
If Right(desPath, 1) <> "/" Then
desPath = desPath + "/"
End If
ChDir srcPath
Workbooks.OpenText FileName:= _
srcPath + FileName, _
Origin:=936, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1)), TrailingMinusNumbers:=True
ChDir desPath
ActiveWorkbook.SaveAs FileName:= _
desPath + FileName, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWindow.Close
End Sub
'调用将c:/下的txt另存为c:/xls目录下，并转换为xls格式
SaveAsExcelInPath "C:/", _
"C:/xls"
