2016年12月7日水曜日

指定フォルダ以下を再帰的更新

Sub 予算表数式一括更新()
    Call freezeexcel
    Call 再帰更新("C:\Users\sys01\Documents\予算表数式更新\TEST")
    Call meltexcel
    MsgBox "処理完了"
End Sub

Sub 再帰更新(パス As String)
    'フォルダの下の全予算表の全シートを変更

    Dim FSO As Object
    Dim フォルダ As Object
    Dim サブフォルダ As Object
    Dim ファイル As Object
    Dim wb As Workbook
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set フォルダ = FSO.GetFolder(パス)
    For Each サブフォルダ In フォルダ.SubFolders
        'フォルダ内のサブフォルダを処理(サブフォルダがなければループ内は通らず)
        再帰更新 サブフォルダ.Path '再帰的呼び出し
    Next サブフォルダ
 
    For Each ファイル In フォルダ.Files 'カレントフォルダ内のファイルを処理
        If (InStr(ファイル.Name, "xlsm") > 0) Then
            'Debug.Print ファイル.Name, ファイル.Path, ファイル.Size
            Set wb = Workbooks.Open(Filename:=ファイル.Path)
            'やりたいことを記述
            wb.Close SaveChanges:=True
        End If
    Next ファイル
End Sub

0 件のコメント:

コメントを投稿