|
|
本帖最后由 413191246se 于 2012-2-17 09:55 编辑
据说“循环遍历文件夹及子文件夹”有三种方法（查找法、递归法、双字典法），本帖介绍的方法是查找法，是我在网络上找到的语句在学习中按 F1 查看帮助时，发现原来微软官方的“VBA帮助”文件中就已经有这些语句了！此种方法可能是最慢的，但对于我等菜鸟来说，简洁实用好用够用易用方便易懂比啥都好，不敢独享，贡献给 VBA 菜鸟朋友们！
“循环遍历文件夹”宏是针对无加密文档的情况！如果文件夹中有加密文档，则在处理过程中会出错，必须加入容错处理语句 On Error Resume Next 在声明前面一行。如果知道密码则键入密码，否则按确定或取消即可跳过！具体实例请参照 doc2txt 宏。
doc2txt 宏，最多一次性可转换 1767 个 Word 文档，建议一次性转换 5、600 个为宜，以免引起 Word 2003 程序崩溃！（txt2doc 宏成功！昨晚发现“确认转换”是TRUE，让它变为FALSE就行了，尚未测试一次性能转换多少个文档。）
重新上传一份特意为“循环遍历文件夹”专题做出的 demo 示例文件（摘自《十七大报告》，方便各位朋友反复演练，可打开“资源管理器”删除和重新解压，加入了3个加密文件，密码分别为123,456,789）：
demo 循环遍历文件夹及子文件夹 - 示例文件.rar
(42.56 KB, 下载次数: 268)
*** 以下为 doc2txt宏、txt2doc宏、循环遍历文件夹（及子文件夹）宏的代码（适用于 Word 2003 VBA），直接拷贝到 VBE 中即可（但“循环遍历文件夹”宏仅仅作为基础，具体拓展实例请参照 doc2txt 宏）：
Sub doc2txt()
On Error Resume Next
Dim fd As FileDialog, i As Long, doc As Document, p As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
Set fd = Nothing
If MsgBox("Are you sure to convert? (" & p & ")", vbYesNo + vbExclamation, "doc2txt") = vbNo Then Exit Sub
With Application.FileSearch
.LookIn = p
.SearchSubFolders = True
.FileName = "*.doc"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set doc = Documents.Open(FileName:=.FoundFiles(i))
doc.SaveAs FileName:=Left(doc.FullName, Len(doc.FullName) - 4) & ".txt", FileFormat:=wdFormatText
ActiveDocument.Close
Next i
MsgBox "Complete! There were " & .FoundFiles.Count & " file(s) converted.", vbOKOnly + vbExclamation, "doc2txt"
Else
MsgBox "There were no files found.", vbOKOnly + vbCritical, "doc2txt"
End If
End With
End Sub
Sub txt2doc()
Dim fd As FileDialog, i As Long, doc As Document, p As String
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
Set fd = Nothing
If MsgBox("Are you sure to convert? (" & p & ")", vbYesNo + vbExclamation, "txt2doc") = vbNo Then Exit Sub
With Application.FileSearch
.LookIn = p
.SearchSubFolders = True
.FileName = "*.txt"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Set doc = Documents.Open(FileName:=.FoundFiles(i), ConfirmConversions:=False)
doc.SaveAs FileName:=Left(doc.FullName, Len(doc.FullName) - 4) & ".doc", FileFormat:=wdFormatDocument
ActiveDocument.Close
Next i
MsgBox "Complete! There were " & .FoundFiles.Count & " file(s) converted.", vbOKOnly + vbExclamation, "txt2doc"
Else
MsgBox "There were no files found.", vbOKOnly + vbCritical, "txt2doc"
End If
End With
End Sub
Sub 循环遍历文件夹()
Dim i As Long, doc As Document
With Application.FileSearch
' .NewSearch
.LookIn = "D:\LoopFolder"
.SearchSubFolders = True
.FileName = "*.doc"
' .FileType = msoFileTypeAllFiles
If .Execute > 0 Then
' MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
' MsgBox .FoundFiles(i)
Set doc = Documents.Open(FileName:=.FoundFiles(i))
doc.Content.Font.Color = wdColorRed
doc.Close savechanges:=wdSaveChanges
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2012-2-11 09:24
发表于 2012-2-11 18:26
楼主
