VBA循环遍历停不下来了，想指定文件夹里的excel文件循环遍历一遍。麻烦高手帮改一下，原代码如下：

Question

Sub 修改()
'
' 修改 Macro
'

'
Application.ScreenUpdating = False
Dim fso, fd, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set fd = fso.getfolder("F:\修改文件")

For Each f In fd.Files
Workbooks.Open f.Path
Application.Run "PERSONAL.XLSB!MacroDel"
ActiveWorkbook.Close False
Next
Application.ScreenUpdating = True
End Sub

Sub MacroDel()
Dim vbcCom, Vbc
Set vbcCom = ActiveWorkbook.VBProject.VBComponents
For Each Vbc In vbcCom
If Vbc.Name Like "Sheet*" Or Vbc.Name Like "This*" Then
Vbc.CodeModule.DeleteLines 1, Vbc.CodeModule.CountOfLines
Else
vbcCom.Remove (Vbc)
End If
Next Vbc
ThisWorkbook.Save
End Sub

Answer 1

For Each f In fd.Files
Workbooks.Open f.Path
Application.Run "PERSONAL.XLSB!MacroDel"
ActiveWorkbook.Close False
Next

if fd.subfolders.count=0 then exit sub

试一下追问

代码：Dim myPath$, myFile$, AK As Workbook
Application.ScreenUpdating = False
myPath = "F:\修改文件\"
myFile = Dir(myPath & "*.xls")
Do While myFile ""
If myFile ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile)
End If
这里有段Sub Macro1()代码
myFile = Dir
Loop
Application.ScreenUpdating = True
End Sub 这个该怎么循环一遍，这个怎么停不下来，先给你分哈