网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的考试资料:

 

标题 VBS实现将Excel表格保存为txt文本
内容
    希望能够找到个能给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
随便看

 

在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。

 

Copyright © 2002-2024 cuapp.net All Rights Reserved
更新时间:2025/5/15 19:31:01