[问题求助] 【已解决】XLS to TXT的VBS代码

locoman

朋友帮我写了个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

• 传一小段样本过来.现在不确定出现乱码的原因,初步推断可能是文件编码的问题.
  
• 至少我WIN10上简单测试,并没有出现空格变?的情况.
  
• 删除?的方法是不可取的.
  
• 敏感信息,请修改相关内容.
  

locoman

回复 2# yhcfsr

谢谢您的热心！！
可以先帮我将前两个需求解决了吧，拜托了，谢谢您！
一、能自动去读取某目录下的所有XLS、XLSX文件，包括主目录下所有子目录下的XLS、XLSX文件；
二、TXT文件统一到一个指定的目录下，且TXT文件名自动以各个XLS、XLSX主文件名命名；

   

——样本现在暂不方便传上来，确实可能与编码有关，因为，这样XLS文件都是从另一个IT系统导出来的，并不是一般手工制作的标准化二维表格。

locoman

传一小段样本过来.现在不确定出现乱码的原因,初步推断可能是文件编码的问题.

yhcfsr 发表于 2018-6-21 16:43

您好，素材样本已补传到1楼了，请帮我看看，谢谢了！

yhcfsr

以下脚本,只是单纯的转换,不会对文件内容进行处理.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

回复 5# yhcfsr

谢谢您的热情帮助！
佩服您的高超能力！
——经测试完全能实现需求，也没有乱码，——完美！
——等大批量测试几次后再结贴吧。
再次感谢大哥哥的帮助！
再次感谢这个论坛的帮助！
七百多个XLS文件转TXT，用时8分钟。
   

locoman

回复 5# yhcfsr


多次测试：
同样七百多个文件，
在WIN7（32位）下耗时8分钟，
在WIN10（64位）下耗时18分钟，
差距有点大。
请问是否有可以优化的？
谢谢您！

yhcfsr

脚本没什么可优化的了.时间差异我没法测试.
去百度一下相关软件,可能比脚本效率高.
EXCLE中用录制宏来处理,也是可行的.

locoman

回复 8# yhcfsr


    谢谢您的帮助，就这样也完全可以使用了！
这个论坛给我们很多很大的帮助，感谢这些热心的达人们！

9zhmke

楼主该给相助者发个红包了...

locoman

我没有这热心达人的微信呀，有的话，一定发个红包给他的，表达谢意和敬意！

locoman

现在，突然发现一个严重问题……
@yhcfsr帮助写的代码能正常将XLS和XLSX转换成TXT，其保存的TXT的编码格式是Unicode格式。

但是，我把这些导出的TXT文件提交到另一个应用系统去处理时，其TXT在该系统中显示为乱码，
原来，该应用系统必须要用ANSI编码格式的TXT文件。

——请问，是否可以将5楼的代码修改为TXT直接保存为ANSI的编码格式。

谢谢再帮我修正一下吧，谢谢了！

Batcher

回复 12# locoman


论坛没有@功能，不过可以点击5楼左下角的那个“回复”，这样yhcfsr就能收到通知了。