| |
▼kazu さん：
ありがとうございます。
動作させてみましたが、”For Each SchFld In Fld”の部分で
『型が一致しません』というエラーがでてしまいます。。
ご教授いただけるようお願いいたします。。
>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 Fld
> 'ファイル名を指定
> Filename = Dir(SchFld & "\" & "*表.xls", VBnomal)
>
> 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/24(木) 21:48 -
