神剑山庄资源网 Design By www.hcban.com
希望能够找到个能给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
有装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
标签:
Excel表格,txt文本
神剑山庄资源网 Design By www.hcban.com
神剑山庄资源网
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件!
如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
神剑山庄资源网 Design By www.hcban.com
暂无VBS实现将Excel表格保存为txt文本的评论...
稳了!魔兽国服回归的3条重磅消息!官宣时间再确认!
昨天有一位朋友在大神群里分享,自己亚服账号被封号之后居然弹出了国服的封号信息对话框。
这里面让他访问的是一个国服的战网网址,com.cn和后面的zh都非常明白地表明这就是国服战网。
而他在复制这个网址并且进行登录之后,确实是网易的网址,也就是我们熟悉的停服之后国服发布的暴雪游戏产品运营到期开放退款的说明。这是一件比较奇怪的事情,因为以前都没有出现这样的情况,现在突然提示跳转到国服战网的网址,是不是说明了简体中文客户端已经开始进行更新了呢?
更新日志
2024年06月18日
2024年06月18日
- dnf2022夏日套有必要买吗
- 《超级马里奥大电影》新作将于2026年4月全球上映!
- 《PUI PUI 天竺鼠车车 THE MOVIE MOLMAX》电影定名
- 任天堂已经关闭的游戏服务器中竟然还有玩家在线?
- 女子十二乐坊首张日本大碟《BeautifulEnergy/美丽能源》原版[WAV+CUE]
- 群星1990-中国老歌精粹VOL.1[T123-02银圈版][WAV+CUE]
- Burmester《ArtForTheEarCD-柏林之声3》【WAV+CUE】
- 陶德遗憾没为《老滚5》等推出更多内容 承诺做出改变
- 快来使用吧!WeGame分享《黑神话:悟空》手机壁纸
- 因《鬼屋魔影RE》未达预期 Embracer关闭工作室
- 郑智化 专业音响示范碟《追梦·往日之声精选集 DSD》[WAV+CUE][400MB]
- 妙音唱片《绝对发烧25HQ 头版限量编号 低速原抓》[WAV+CUE][670MB]
- 《张玮伽2024 海浪 HQCDII限量版 天艺》[WAV+CUE][640MB]
- 幽夜默示录其一怎么过?秘境通过攻略分享
- 【原神】枫丹世界任务 | 我们的目标在另一条管道