循环遍历文件夹_doc2txt & txt2doc（宏）

413191246se

* 功能：将 Word2003 文档（*.doc）转换为文本文档（*.txt）。doc2txt=doc to txt。或：将文本文档（*.txt）转换为 Word2003 文档（*.doc）。txt2doc=txt 2 doc。
* 当转换有密码的 Word 文档时，记得密码就输入密码，不记得就打《确定》或《取消》均可，程序会继续。
* 注意：在进行转换时，一次不要太多，建议不要超过 300/400 个文件，否则，Word 可能会崩溃（崩溃的原因是遇到了引起崩溃的文件，如果没有遇到引起崩溃的文件，可能理论上无限）。
* 注意：在进行转换时，不要进行键盘/鼠标操作，请耐心等待，不想等待可按 Ctrl + PauseBreak 键中止程序。
* 循环遍历文件夹_doc2txt & txt2doc（宏）代码：

1. Sub 循环遍历文件夹_doc2txt_txt2doc()
   
2.     On Error Resume Next
   
3.     Dim fd As FileDialog, i As Long, doc As Document, p As String, t As Long
   
4.     Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
5.     If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
   
6.     Set fd = Nothing
   
7.     If MsgBox("是否将 Word 文档(*.doc)转换为文本文档(*.txt)？（否则，将文本文档(*.txt)转换为 Word 文档(*.doc)）", vbYesNo + vbExclamation, "循环遍历文件夹_doc2txt & txt2doc") = vbYes Then t = 0 Else t = 1
   
8.     If MsgBox("是否转换文件夹 " & p & " ?", vbYesNo + vbExclamation, "循环遍历文件夹_doc2txt & txt2doc") = vbNo Then Exit Sub
   
9.     With Application.FileSearch
   
10.         .NewSearch
    
11.         .LookIn = p
    
12.         .SearchSubFolders = True
    
13.         If t = 0 Then .FileName = "*.doc" Else .FileName = "*.txt"
    
14.         If .Execute > 0 Then
    
15.             For i = 1 To .FoundFiles.Count
    
16.                 If t = 0 Then
    
17.                     Set doc = Documents.Open(FileName:=.FoundFiles(i))
    
18.                     doc.SaveAs FileName:=Left(doc.FullName, Len(doc.FullName) - 4) & ".txt", FileFormat:=wdFormatText
    
19.                 Else
    
20.                     Set doc = Documents.Open(FileName:=.FoundFiles(i), ConfirmConversions:=False)
    
21.                     doc.SaveAs FileName:=Left(doc.FullName, Len(doc.FullName) - 4) & ".doc", FileFormat:=wdFormatDocument
    
22.                 End If
    
23.                 ActiveDocument.Close
    
24.             Next i
    
25.             MsgBox "转换完毕！共转换 " & .FoundFiles.Count & " 个文件！", vbOKOnly + vbExclamation, "循环遍历文件夹_doc2txt & txt2doc"
    
26.         Else
    
27.             MsgBox "未发现文件！", vbOKOnly + vbCritical, "循环遍历文件夹_doc2txt & txt2doc"
    
28.         End If
    
29.     End With
    
30. End Sub

复制代码

swszlm

谢谢分享！

13907933959

师傅、这个好！徒弟下载收藏了！