VBS實(shí)現(xiàn)將Excel表格保存為txt文本

更新時(shí)間：2012年12月10日 16:42:17 作者：

希望能夠找到個(gè)能給excel表另存為TXT的VBS代碼，雖然另存為可以選擇，但還是需要直接VBS執(zhí)行這一步另存為TXT格式的，應(yīng)該如何寫代碼呢

希望能夠找到個(gè)能給excel表另存為TXT的VBS代碼，雖然另存為可以選擇，但還是需要直接VBS執(zhí)行這一步另存為TXT格式的，應(yīng)該如何寫代碼呢？

有裝Excel的話，就會(huì)比較簡(jiǎn)單，下面的是通用的不裝Office也可以運(yùn)行的，如下:
VBScript code:

復(fù)制代碼代碼如下:

 
Set oShell = CreateObject("Shell.Application") 
Set oDir = oShell.BrowseForFolder(0,"選擇目錄",0) 
For Each x In oDir.Items 
If LCase(Right(x.Path,4)) = ".xls" Then 
XLS2TXT x.Path 
End If 
Next 
'**************************************************************************************** 
'開始轉(zhuǎn)換 
'**************************************************************************************** 
Sub XLS2TXT(strFileName) 
'若有裝Excel只需 
'oExcel.ActiveWorkbook.SaveAs strFileName & ".txt", -4158 
'下面的方法適合沒有裝Office的系統(tǒng) 
On Error Resume Next 
Dim oConn,oAdox,oRecordSet 
Set oConn = CreateObject("Adodb.Connection") 
Set oAdox = CreateObject("Adox.Catalog") 
sConn = "Provider = Microsoft.Jet.Oledb.4.0;" & _ 
"Data Source = " & strFileName & ";" & _ 
"Extended Properties = ""Excel 8.0; HDR=No"";" 
sSQL = "Select * From " 
oConn.Open sConn 
if Err Then 
Msgbox "錯(cuò)誤代碼:" & Err.Number & VbCrLf & Err.Description 
Err.Clear 
else 
oAdox.ActiveConnection = oConn 
sSQL = sSQL & "[" & oAdox.Tables(0).Name & "]" '為了簡(jiǎn)便，只處理第一個(gè)工作表 
Set oRecordSet = oConn.Execute(sSQL) 
if Err Then 
Msgbox "錯(cuò)誤代碼:" & Err.Number & VbCrLf & Err.Description 
Err.Clear 
else 
Write strFileName & ".txt",oRecordSet.GetString 
end if 
end If 
oRecordSet.Close 
oConn.Close 
Set oRecordSet = Nothing 
Set oAdox = Nothing 
Set oConn = Nothing 
End Sub 
'**************************************************************************************** 
'寫入文件，同名覆蓋，無則創(chuàng)建 
'**************************************************************************************** 
Sub Write(strName,str) 
Dim oFSO,oFile 
Set oFSO = CreateObject("Scripting.FileSystemObject") 
Set oFile = oFSO.OpenTextFile(strName,2,True) '不存在則創(chuàng)建,強(qiáng)制覆蓋 
oFile.Write str 
oFile.Close 
Set oFile = Nothing 
Set oFSO = Nothing 
End Sub 