[已处理]如何修改该段doc文档转化为txt的VBS？

coolrat

近日在网络上搜寻到一段批量doc文档转化为txt，试验之后，效果还不多，源码参见
   
http://skday.com/archives/418/

1. 
   
2. Dim array1(100) '①100表示该文件夹最多的文件数，如果文件数大于100请自行修改
   
3. Dim source(100) '①100表示该文件夹最多的文件数，如果文件数大于100请自行修改
   
4. Dim destination(100) '①100表示该文件夹最多的文件数，如果文件数大于100请自行修改
   
5. Set fs = CreateObject("Scripting.FileSystemObject")
   
6. Set f = fs.GetFolder("D:\我的doc") '②此处表示doc所在的文件夹，请根据需要自行修改
   
7. Set fc = f.Files
   
8. i = 0
   
9. For Each f1 In fc
   
10.     array1(i) = f1.Name
    
11.     Ext = fs.GetExtensionName(array1(i))
    
12.     Ext = LCase(Ext)
    
13.     If Ext = "doc" Then '③此处表示转换类型
    
14.         source(i) = f & "" & array1(i)
    
15.         destination(i) = Left(source(i), Len(source(i)) - 4) & ".txt"
    
16.         Set wordApp = CreateObject("Word.Application")
    
17.         Set wordDoc = wordApp.Documents.Open(source(i))
    
18.         wordDoc.SaveAs destination(i), 7
    
19.         wordDoc.Close
    
20.         Set wordDoc = Nothing
    
21.         wordApp.Quit
    
22.         Set wordApp = Nothing
    
23.     End If
    
24.     i = i + 1
    
25. Next
    
26. 
    

复制代码

问题是：
如果在此段代码基础上实现以下几项，该如何修改？

① 让vbs自动对所在文件夹内对象运行，则不需要指定具体文件夹，所转化的TXT也在同一文件夹内。

② 能否同时转化doc和docx两种甚至两种以上的文件类型？

③ 所有的文件转化完成后，屏幕显示“转化完毕”

broly

1. Dim word,doc,fso,fc,f
   
2. Dim strBaseName,strExtName
   
3. 
   
4. Set fso = CreateObject("Scripting.FileSystemObject")
   
5. Set fc = fso.GetFolder(".").Files
   
6. 
   
7. Set word = CreateObject("Word.Application")
   
8. 
   
9. For Each f In fc
   
10.         strExtName = LCase( fso.GetExtensionName(f.Path) )
    
11.        
    
12.         If strExtName="doc" Or strExtName="docx" Then
    
13.                 strBaseName = fso.GetBaseName(f.Path)
    
14.                 Set doc = word.Documents.Open(f.Path)
    
15.                
    
16.                 doc.SaveAs fso.GetFolder(".") & "" & strBaseName & ".txt",7
    
17.                
    
18.                 doc.Close
    
19.        
    
20.         End If
    
21. Next
    
22. 
    
23. MsgBox "转换完成"
    
24. 
    
25. Set fso = Nothing
    
26. Set fc = Nothing
    
27. Set f = Nothing
    
28. Set word = Nothing
    
29. Set doc = Nothing

复制代码

coolrat

回复 2# broly

衷心感谢broly君及时援手相助,经试验，其修改能实现处理目标。