|
同様な処理の繰り返しなら、Loop処理でまとめてしまえば良いです。
それに、Dir1〜Dir12 はどうやって指定しますか?
InputBoxでそれぞれ指定するくらいなら、作業用セルにフォルダ名を入力しておいて、
その範囲をLoopしてあげれば良いでしょう。
下記はA1:A12のセル範囲にフォルダ名が入力してあるとします。
Sub test()
Const cnsDIR = "\*.*"
Dim strFILENAME As String
Dim GYO As Long
Dim r As Range
Dim v
Application.ScreenUpdating = False
Set r = Range("AP1")
For Each v In Range("A1:A12").Value
If Not IsEmpty(v) Then
If Dir(v, vbDirectory) = "" Then
r.Value = "指定のフォルダは存在しません。"
Else
strFILENAME = Dir(v & cnsDIR, vbNormal)
GYO = 0
Do While strFILENAME <> ""
r.Offset(GYO).Value = strFILENAME
GYO = GYO + 1
strFILENAME = Dir()
Loop
End If
If GYO > 1 Then r.Resize(GYO).Sort Key1:=r
End If
Set r = r.Offset(, 1)
Next
Set r = Nothing
Application.ScreenUpdating = True
End Sub
|
|