标题: [问题求助] 【已解决】XLS to TXT的VBS代码 [打印本页]
作者: locoman 时间: 2018-6-21 14:50 标题: 【已解决】XLS to TXT的VBS代码
朋友帮我写了个XLS文件转换为TXT文件的VBS。
能实现转换,但需要进一步优化一下,在此请教达人帮帮我。
拜托,先谢谢了!
——原VBS文件代码:- dim objexcel,f,path
- set objExcel = CreateObject("Excel.Application")
-
- Set objWorkbook = objExcel.Workbooks.Open ("F:\test\temp\2社会管理 市政 市政绿化.xls")
- intRow = 1
- strDN = ""
- Do Until objExcel.Cells(intRow,1).Value = ""
- objExcel.Cells(intRow,2).Value = intRow
- intRow = intRow + 1
- Loop
-
- objExcel.DisplayAlerts =false '屏蔽保存确认对话框
- 'application.displayalerts=false
- objExcel.Workbooks(1).SaveAS "F:\test\temp\2社会管理 市政 市政绿化.txt",-4158,ture 'EXCEL文件另存为TXT文件
- objExcel.Workbooks(1).Close,ture '关闭工作表
- objExcel.Quit ' 退出
-
- 'wscript.echo "保存成功"
- 'wscript.sleep 10000 '挂起10秒,此属性单位为毫秒
- 'fso.CreateTextFile(xx,true).write(xx)写入txt
复制代码
——需要优化的需求:
一、能自动去读取某目录下的所有XLS、XLSX文件,包括主目录下所有子目录下的XLS、XLSX文件;
二、TXT文件统一到一个指定的目录下,且TXT文件名自动以各个XLS、XLSX主文件名命名;
三、该VBS转换成的TXT文件,内容中字符之间的空格字符全部变成了?号;需要将该?号自动删除后再保存;见下面示例:
受?理??单?位? ?街道 > 社区 受??理??人? ?朱有才
反映人姓名? ?陈女士 性????????别? ?女
受 身?份??证?号? ?5001************ 联系电话?
拜托各位,谢谢了!
作者: yhcfsr 时间: 2018-6-21 16:43
本帖最后由 yhcfsr 于 2018-6-21 16:47 编辑
- 传一小段样本过来.现在不确定出现乱码的原因,初步推断可能是文件编码的问题.
- 至少我WIN10上简单测试,并没有出现空格变?的情况.
- 删除?的方法是不可取的.
- 敏感信息,请修改相关内容.
作者: locoman 时间: 2018-6-21 22:25
本帖最后由 locoman 于 2018-6-21 22:28 编辑
回复 2# yhcfsr
谢谢您的热心!!
可以先帮我将前两个需求解决了吧,拜托了,谢谢您!
一、能自动去读取某目录下的所有XLS、XLSX文件,包括主目录下所有子目录下的XLS、XLSX文件;
二、TXT文件统一到一个指定的目录下,且TXT文件名自动以各个XLS、XLSX主文件名命名;
——样本现在暂不方便传上来,确实可能与编码有关,因为,这样XLS文件都是从另一个IT系统导出来的,并不是一般手工制作的标准化二维表格。
作者: locoman 时间: 2018-6-22 08:40
传一小段样本过来.现在不确定出现乱码的原因,初步推断可能是文件编码的问题.
yhcfsr 发表于 2018-6-21 16:43
您好,素材样本已补传到1楼了,请帮我看看,谢谢了!
作者: yhcfsr 时间: 2018-6-22 09:58
以下脚本,只是单纯的转换,不会对文件内容进行处理.TXT编码为UNICODE,应该可以解决乱码问题.
使用方法:在用户设置区,将路径设置好即可.- '==============用户设置区================='
- Dim source,destination
- source="d:\test" '源目录
- destination="e:\test" '目的目录
- '========================================='
-
- '=================函数定义区=============='
- '脚本功能:EXCEL文件另存为TXT'
- Function FilesTree(oFolder,dPath,objExcel)
-
- '处理当前目录文件
- Set oFiles = oFolder.Files
- For Each oFile In oFiles
- exName=LCase(Right(oFile.Name,Len(oFile.Name)-InstrRev(oFile.Name,".")+1))
- baseName=Left(oFile.Name,InstrRev(oFile.Name,".")-1)
- If exName=".xls" Or exName=".xlsx" Then
- set objWorkbook=objExcel.Workbooks.open(oFile.Path)
- objExcel.Workbooks(1).SaveAS dPath&"\"&baseName&".txt",42,true
- objExcel.Workbooks(1).Close,ture
- End If
- Next
-
- '递归处理子目录文件
- Set oSubFolders = oFolder.SubFolders
- For Each oSubFolder In oSubFolders
- FilesTree oSubFolder,dPath,objExcel
- Next
-
- End Function
- '================函数定义区结束================='
-
- '================主程序开始====================='
- Set oFso = CreateObject("Scripting.FileSystemObject")
-
- If oFso.FolderExists(source) And oFso.FolderExists(destination) Then
- set objExcel=CreateObject("Excel.Application")
- Set oFolder = oFso.GetFolder(source)
- objExcel.DisplayAlerts = False
- FilesTree oFolder,destination,objExcel
- objExcel.DisplayAlerts = True
- objExcel.Quit ' 退出
- 'msgbox "处理完成"&vbCrlf&" 即将打开目的目录"
- CreateObject("Wscript.Shell").run destination
- Else
- msgbox "源目录或目的目录不存在"
- End If
复制代码
作者: locoman 时间: 2018-6-22 14:10
本帖最后由 locoman 于 2018-6-22 14:43 编辑
回复 5# yhcfsr
谢谢您的热情帮助!
佩服您的高超能力!
——经测试完全能实现需求,也没有乱码,——完美!
——等大批量测试几次后再结贴吧。
再次感谢大哥哥的帮助!
再次感谢这个论坛的帮助!
七百多个XLS文件转TXT,用时8分钟。
作者: locoman 时间: 2018-6-23 13:38
回复 5# yhcfsr
多次测试:
同样七百多个文件,
在WIN7(32位)下耗时8分钟,
在WIN10(64位)下耗时18分钟,
差距有点大。
请问是否有可以优化的?
谢谢您!
作者: yhcfsr 时间: 2018-6-23 21:34
脚本没什么可优化的了.时间差异我没法测试.
去百度一下相关软件,可能比脚本效率高.
EXCLE中用录制宏来处理,也是可行的.
作者: locoman 时间: 2018-6-24 15:44
本帖最后由 locoman 于 2018-6-24 15:46 编辑
回复 8# yhcfsr
谢谢您的帮助,就这样也完全可以使用了!
这个论坛给我们很多很大的帮助,感谢这些热心的达人们!
作者: 9zhmke 时间: 2018-6-26 15:10
楼主该给相助者发个红包了...
作者: locoman 时间: 2018-6-30 13:56
我没有这热心达人的微信呀,有的话,一定发个红包给他的,表达谢意和敬意!
作者: locoman 时间: 2018-7-2 13:06
本帖最后由 locoman 于 2018-7-2 13:09 编辑
现在,突然发现一个严重问题……
@yhcfsr帮助写的代码能正常将XLS和XLSX转换成TXT,其保存的TXT的编码格式是Unicode格式。
但是,我把这些导出的TXT文件提交到另一个应用系统去处理时,其TXT在该系统中显示为乱码,
原来,该应用系统必须要用ANSI编码格式的TXT文件。
——请问,是否可以将5楼的代码修改为TXT直接保存为ANSI的编码格式。
谢谢再帮我修正一下吧,谢谢了!
作者: Batcher 时间: 2018-7-2 13:56
回复 12# locoman
论坛没有@功能,不过可以点击5楼左下角的那个“回复”,这样yhcfsr就能收到通知了。
欢迎光临 批处理之家 (http://bathome.net./) |
Powered by Discuz! 7.2 |