VBS实现将Excel表格保存为txt文本
2016-07-05来源:易贤网

希望能够找到个能给excel表另存为TXT的VBS代码,虽然另存为可以选择,但还是需要直接VBS执行这一步另存为TXT格式的,应该如何写代码呢?

有装Excel的话,就会比较简单,下面的是通用的不装Office也可以运行的,如下:

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

'****************************************************************************************

'开始转换

'****************************************************************************************

Sub XLS2TXT(strFileName)

'若有装Excel只需

'oExcel.ActiveWorkbook.SaveAs strFileName & ".txt", -4158

'下面的方法适合没有装Office的系统

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 "错误代码:" & Err.Number & VbCrLf & Err.Description

Err.Clear

else

oAdox.ActiveConnection = oConn

sSQL = sSQL & "[" & oAdox.Tables(0).Name & "]" '为了简便,只处理第一个工作表

Set oRecordSet = oConn.Execute(sSQL)

if Err Then

Msgbox "错误代码:" & 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

'****************************************************************************************

'写入文件,同名覆盖,无则创建

'****************************************************************************************

Sub Write(strName,str)

Dim oFSO,oFile

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFile = oFSO.OpenTextFile(strName,2,True) '不存在则创建,强制覆盖

oFile.Write str

oFile.Close

Set oFile = Nothing

Set oFSO = Nothing

End Sub

2025公考·省考培训课程试听预约报名

  • 报班类型
  • 姓名
  • 手机号
  • 验证码
推荐信息