Dir

Sub 遍历文件1()
Path = ThisWorkbook.Path & "\文件夹的创建与遍历" '注意路径最后要带 ""
ss = Dir(Path) '遍历路径下所有文件,会排除隐藏属性的文件
Do
Range("a1").Offset(n, 0) = ss
ss = Dir
n = n + 1
Loop Until ss = ""
End Sub
Sub 遍历文件2()
Path = ThisWorkbook.Path & "\文件夹的创建与遍历"
ss = Dir(Path & ".xlsm") '遍历指定格式文件
Do
Range("a1").Offset(n, 1) = ss
ss = Dir
n = n + 1
Loop Until ss = ""
End Sub
Sub 遍历文件3()
Path = ThisWorkbook.Path & "\文件夹的创建与遍历"
ss = Dir(Path & "创建*") '遍历指定名称文件
Do
Range("a1").Offset(n, 2) = ss
ss = Dir
n = n + 1
Loop Until ss = ""
End Sub
Sub 遍历文件及文件夹1()
Path = ThisWorkbook.Path & "\文件夹的创建与遍历"
ss = Dir(Path, vbDirectory)
Do

    Range("a1").Offset(n, 3) = ss
    n = n + 1

    ss = Dir
    
Loop Until ss = ""

End Sub
Sub 遍历文件及文件夹2()
Path = ThisWorkbook.Path & "\文件夹的创建与遍历"
ss = Dir(Path, vbDirectory)
Do
If ss <> "." And ss <> ".." Then '将.、..排除掉
Range("a1").Offset(n, 4) = ss
n = n + 1
End If
ss = Dir

Loop Until ss = ""

End Sub

Sub 遍历文件夹2()
Path = ThisWorkbook.Path & "\文件夹的创建与遍历"
ss = Dir(Path, vbDirectory)
Do
If ss <> "." And ss <> ".." Then '将.、..排除掉
x = Application.WorksheetFunction.CountIf(Range("a:a"), ss)
If x = 0 Then
Range("a1").Offset(n, 5) = ss
n = n + 1
End If
End If
ss = Dir

Loop Until ss = ""
End Sub

Sub 其他之新建文件夹和批量修改文件名称()

'判断不存在后再创建新文件夹
path1 = ThisWorkbook.Path & "\创建的新文件夹\"
ss = Dir(path1, vbDirectory)
If ss = "" Then MkDir path1

'生成模拟文件
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For i = 1 To 12
    Workbooks.Add
    ActiveWorkbook.SaveAs path1 & "abc公司" & i & "月.xlsx"
    ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'获取文件名
ss = Dir(path1)
Do
    n = n + 1
    Sheet2.Cells(n, 1) = path1 & ss
    ss = Dir
Loop Until ss = ""

'复制到新的一列,替换后再修改文件名
Sheet2.Range("a1", Sheet2.Range("a1").End(xlDown)).Copy [b1]
Sheet2.Range("b1", "b12").Replace "abc公司", "ABC", lookat:=False, MatchCase:=False  'lookat是否完全匹配，MatchCase是否区分大小写
Dim rng As Range
For Each rng In Sheet2.Range("a1:a12")
    Name rng As rng.Offset(0, 1).Value
Next

End Sub