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

字號(hào):


    希望能夠找到個(gè)能給excel表另存為TXT的VBS代碼,雖然另存為可以選擇,但還是需要直接VBS執(zhí)行這一步另存為TXT格式的,應(yīng)該如何寫代碼呢?
    有裝Excel的話,就會(huì)比較簡單,下面的是通用的不裝Office也可以運(yùn)行的,如下:
    VBScript code:
    代碼如下:
    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 & "]" '為了簡便,只處理第一個(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