|
StopLv ← 何階層堀り下げるかの設定。
StopLv = 999 なら最下位層迄です。
会社なんで、Officeが97環境しか無いんで
Split97 という関数使ってますが、2000以降であればSplitで問題ないと思います。
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()
Cons_Fld = "C:\test"
StopLv = 999
Set myFso = CreateObject("Scripting.FileSystemObject")
Set myFld = myFso.GetFolder(Cons_Fld).SubFolders
ReDim AryFld(0)
AryFld(0) = Cons_Fld
n = 1
c = 1
Do
'アクセス出来ないフォルダ(System Volume Information等)へのアクセス考慮
On Error Resume Next
If Not Err Then
For Each Fld In myFld
If Not IsEmpty(Fld) Then
If Lv_Chk(Cons_Fld, Fld.Path) <= StopLv - 1 Or StopLv = 999 Then
ReDim Preserve AryFld(n)
AryFld(n) = Fld.Path
n = n + 1
End If
End If
Next
Else
Err.Clear
End If
On Error GoTo 0
If i > c Then Set myFld = myFso.GetFolder(AryFld(c)).SubFolders
c = c + 1
Loop Until c > i
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
Function Lv_Chk(Fld_Main, StrFld)
Cnt = InStr(1, Fld_Main, StrFld)
Tmp = Split97(Mid(StrFld, Len(Fld_Main) + 1), "\")
Lv_Chk = UBound(Tmp)
End Function
Function Split97(ByVal StrTmp, ByVal Strbunri)
Dim Split97Tmp() '配列一時格納用
Dim i As Long 'カウンタ変数
Dim IntTmp As Long '区切り文字位置格納用変数
IntTmp = InStr(1, StrTmp, Strbunri)
If IntTmp = 0 Then
ReDim Split97Tmp(0)
Split97Tmp(0) = StrTmp
Else
Do Until IntTmp = 0
ReDim Preserve Split97Tmp(i)
Split97Tmp(i) = Left(StrTmp, IntTmp - 1)
i = i + 1
StrTmp = Mid(StrTmp, IntTmp + Len(Strbunri))
IntTmp = InStr(1, StrTmp, Strbunri)
Loop
End If
ReDim Preserve Split97Tmp(i)
Split97Tmp(i) = StrTmp
Split97 = Split97Tmp
End Function
|
|