| |
▼kazu さん：
ありがとうございます。
動作確認してみました。。
階層を９９９（最下位までと指定している）のですがやはり、１階層下までしか
検索してないようなのですが、２０００と９７で動作が違うのでしょうか？
また、質問ばかりになってしまうのですが、
'アクセス出来ないフォルダ（System Volume Information等）へのアクセス考慮
というのは具体的に何を行っているのでしょうか？
お忙しい中恐縮ですが、ご教授お願いいたします。
> 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
>
|
|
桜
- 05/2/28(月) 15:11 -
