| |
>▼kazuさん,ichinoseさん、でれすけ さん：
度々質問で恐縮ですが、、
下記コードで、Sub_Fld.Countとしてあるので
２階層以上検索できるようになっているのでしょうか？
動作させてみたところ、指定した１つ下のサブフォルダまでは検索できるのですが
２階層以上下のフォルダまでは検索できる方法はありますか？
フォルダ配下にサブフォルダが不特定数ある場合に下記を応用することは
可能でしょうか？
度重なる質問で恐縮ですがよろしくお願いいたします。
Sub test()
Dim Mydir As String
Dim Filename As String
Dim mySh As String
Dim a As String
Dim myRng As Range
Dim i As Long
Dim n, ShtName, Flg
Dim AryFld()
Set Myfso = CreateObject("Scripting.FileSystemObject")
Set Sub_Fld = Myfso.GetFolder("C:\test").SubFolders
Redim Preserve AryFld(Sub_Fld.Count)
n = 1
ReDim AryFld(Sub_Fld.Count)
AryFld(0) = "C:\test"
n = 1
For Each Fld In Sub_Fld
AryFld(N) = Fld.Path
n = n + 1
Next
Set Sub_Fld = Nothing
Set Myfso = Nothing
For Each SchFld In AryFld
'ファイル名を指定
Filename = Dir(SchFld & "\" & "*表.xls", vbNormal)
Do While Filename <> ""
'ファイルを開く
Workbooks.Open SchFld & "\" & Filename
'シートの有無を確認
ShtName = "VER5.0"
Flg = True
For n = 1 To Worksheets.Count
If StrConv(Worksheets(n).Name, vbUpperCase + vbNarrow) = ShtName Then
Flg = False
Exit For
End If
Next n
'シートVer5.0がある場合
If Flg = False Then
'MsgBox ShtName & "は存在します。"
'シートを選択
With Sheets("Ver5.0")
For i = 5 To .Range("j65536").End(xlUp).Row
If .Cells(i, "j").Value <> "" Then
.Cells(i, "j").Offset(, 1).Value = "OK"
End If
Next
End With
Workbooks(Filename).Save
Workbooks(Filename).Close
'シートVer5.0がない場合
Else
' MsgBox ShtName & "は存在しません。"
Workbooks(Filename).Close
End If
'End If
Filename = Dir()
Loop
Next
End Sub
|
|
桜
- 05/2/28(月) 1:12 -
