Sub 简单遍历测试()
For Each F In Dir遍历 'Office2003遍历,FSO遍历,双字典遍历,CMD遍历,栈遍历,管道遍历,Dir遍历
'此处加入文件处理代码即可。
Selection.InsertAfter F & Chr(13)
i = i + 1
Next
Selection.InsertAfter i
MsgBox "OKOK!!!", vbOKOnly, "OKKO"
End Sub
Sub 单个文档处理(F)
Dim pa As Paragraph, c As Range
With Documents.Open(F, Visible:=False)
For Each pa In .Paragraphs
For Each c In pa.Range.Characters
If c.Font.Name = "仿宋" And Abs(Asc(c)) > 128 Then
c.Font.Name = "仿宋_GB2312"
ElseIf c.Font.Name = "仿宋" And Abs(Asc(c)) < 128 Then
c.Font.Name = "Times New Roman"
End If
Next
Next
.Close True
End With
End Sub
' 遍历文件夹
Function CMD遍历()
Dim arr
Dim t: t = Timer
With Application.FileDialog(msoFileDialogFolderPicker)
' .InitialFileName = "D:\" '若不加这句则打开上次的位置
If .Show <> -1 Then Exit Function
fod = .InitialFileName
End With
CMD遍历文件 arr, fod, "*.doc*"
arr = Filter(arr, "*", False, vbTextCompare)
CMD遍历 = arr
End Function
Function 栈遍历()
Dim arr() As String
Dim t: t = Timer
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> -1 Then Exit Function
fod = .InitialFileName
End With
遍历栈 arr, CStr(fod), "doc*", True '这种方式就不用使用Function在函数中返回了
栈遍历 = arr
End Function
Function 管道遍历()
Dim t: t = Timer
Dim a As New DosCMD
Dim arr
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show <> -1 Then Exit Function
fod = .InitialFileName
End With
a.DosInput Environ$("comspec") & " /c dir " & Chr(34) & fod & "\*.doc*" & Chr(34) & " /s /b /a:-d"
arr = a.DosOutPutEx '默认等待时间120s
arr = Split(arr, vbCrLf) '分割成数组
arr = Filter(arr, ".doc", True, vbTextCompare) '仅保留doc文件
arr = Filter(arr, "*", False, vbTextCompare)
arr = Filter(arr, "$", False, vbTextCompare)
管道遍历 = arr
'For Each F In arr
' If InStr(F, "$") = 0 And F <> "" Then
' Debug.Print F
' '单个文档处理代码 (F)'------------------------------------------------------------------------------★★★★★★★★★★★★★★★
' End If
'Next
'MsgBox "已完成!!!", vbOKCancel, "代码处理"
End Function
Function AllName() '遍历获得文件名,交给数组,不变的部分;'选定的所有word文档
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Add "选择03版word文档", "*.doc", 1
.Filters.Add "所有文件", "*.*", 2
If .Show <&g