Board logo

标题: [问题求助] 【已解决】XLS to TXT的VBS代码 [打印本页]
作者: locoman    时间: 2018-6-21 14:50     标题: 【已解决】XLS to TXT的VBS代码

朋友帮我写了个XLS文件转换为TXT文件的VBS。
能实现转换，但需要进一步优化一下，在此请教达人帮帮我。
拜托，先谢谢了！

——原VBS文件代码：
  1. dim objexcel,f,path

  2. set objExcel = CreateObject("Excel.Application")

  3. 

  4. Set objWorkbook = objExcel.Workbooks.Open ("F:\test\temp\2社会管理 市政 市政绿化.xls")

  5. intRow = 1

  6. strDN = ""

  7. Do Until objExcel.Cells(intRow,1).Value = ""

  8. objExcel.Cells(intRow,2).Value = intRow

  9. intRow = intRow + 1

  10. Loop

  11. 

  12. objExcel.DisplayAlerts =false '屏蔽保存确认对话框

  13. 'application.displayalerts=false

  14. objExcel.Workbooks(1).SaveAS "F:\test\temp\2社会管理 市政 市政绿化.txt",-4158,ture 'EXCEL文件另存为TXT文件

  15. objExcel.Workbooks(1).Close,ture '关闭工作表

  16. objExcel.Quit ' 退出 

  17. 

  18. 'wscript.echo "保存成功"

  19. 'wscript.sleep 10000 '挂起10秒，此属性单位为毫秒 

  20. '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 编辑

作者: 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,应该可以解决乱码问题.
    使用方法:在用户设置区,将路径设置好即可.
    1. '==============用户设置区================='

    2. Dim source,destination

    3. source="d:\test"      '源目录

    4. destination="e:\test" '目的目录

    5. '========================================='

    6. 

    7. '=================函数定义区=============='

    8. '脚本功能:EXCEL文件另存为TXT'

    9. Function FilesTree(oFolder,dPath,objExcel)

    10.   

    11. 	'处理当前目录文件

    12. 	Set oFiles = oFolder.Files    

    13. 	For Each oFile In oFiles

    14. 		exName=LCase(Right(oFile.Name,Len(oFile.Name)-InstrRev(oFile.Name,".")+1))

    15. 		baseName=Left(oFile.Name,InstrRev(oFile.Name,".")-1)

    16.     If exName=".xls" Or exName=".xlsx"  Then 

    17. 		set objWorkbook=objExcel.Workbooks.open(oFile.Path)

    18. 		objExcel.Workbooks(1).SaveAS dPath&"\"&baseName&".txt",42,true

    19. 		objExcel.Workbooks(1).Close,ture

    20. 	End If

    21. 	Next    

    22.     

    23. 	'递归处理子目录文件 

    24. 	Set oSubFolders = oFolder.SubFolders 

    25. 	For Each oSubFolder In oSubFolders      

    26. 		FilesTree oSubFolder,dPath,objExcel   

    27. 	Next    

    28. 	

    29. End Function

    30. '================函数定义区结束================='

    31. 

    32. '================主程序开始====================='

    33. Set oFso = CreateObject("Scripting.FileSystemObject")    

    34. 

    35. If oFso.FolderExists(source) And oFso.FolderExists(destination) Then

    36. 	set objExcel=CreateObject("Excel.Application")

    37. 	Set oFolder = oFso.GetFolder(source) 

    38. 	objExcel.DisplayAlerts = False

    39. 	FilesTree oFolder,destination,objExcel

    40. 	objExcel.DisplayAlerts = True

    41. 	objExcel.Quit ' 退出 

    42. 	'msgbox "处理完成"&vbCrlf&" 即将打开目的目录"

    43. 	CreateObject("Wscript.Shell").run destination

    44. Else

    45. 	msgbox "源目录或目的目录不存在"

    46. 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://bbs.bathome.net/) Powered by Discuz! 7.2