vba遍历字符串_Notes-VBA-遍历

Sub遍历()For Each F In Dir遍历 'Office2003遍历,FSO遍历,双字典遍历,CMD遍历,栈遍历,管道遍历,Dir遍历

'此处加入文件处理代码即可。

Selection.InsertAfter F & Chr(13)

i= i + 1

NextSelection.InsertAfter iMsgBox "OKOK!!!", vbOKOnly, "OKKO"

End Sub

Sub单个文档处理(F)Dim pa As Paragraph, c AsRangeWith Documents.Open(F, Visible:=False)For Each pa In.ParagraphsFor Each c Inpa.Range.CharactersIf c.Font.Name = "仿宋" And Abs(Asc(c)) > 128 Thenc.Font.Name= "仿宋_GB2312"

ElseIf c.Font.Name = "仿宋" And Abs(Asc(c)) < 128 Thenc.Font.Name= "Times New Roman"

End If

Next

Next.CloseTrue

End With

End Sub

'遍历文件夹

FunctionCMD遍历()DimarrDim t: t =TimerWithApplication.FileDialog(msoFileDialogFolderPicker)'.InitialFileName = "D:\" '若不加这句则打开上次的位置

If .Show <> -1 Then Exit Functionfod=.InitialFileNameEnd WithCMD遍历文件 arr, fod,"*.doc*"arr= Filter(arr, "*", False, vbTextCompare)

CMD遍历=arrEnd Function

Function栈遍历()Dim arr() As String

Dim t: t =TimerWithApplication.FileDialog(msoFileDialogFolderPicker)If .Show <> -1 Then Exit Functionfod=.InitialFileNameEnd With遍历栈 arr,CStr(fod), "doc*", True '这种方式就不用使用Function在函数中返回了

栈遍历 =arrEnd Function

Function管道遍历()Dim t: t =TimerDim a As NewDosCMDDimarrWithApplication.FileDialog(msoFileDialogFolderPicker)If .Show <> -1 Then Exit Functionfod=.InitialFileNameEnd Witha.DosInputEnviron$("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文档

WithApplication.FileDialog(msoFileDialogFilePicker)

.Filters.Add"选择03版word文档", "*.doc", 1.Filters.Add"所有文件", "*.*", 2

If .Show <> -1 Then Exit Function

For Each F In.SelectedItemsIf InStr(F, "$") = 0 Thenstr0= str0 & F & Ch