任意フォルダ内の全てのエクセルに対して同じ処理をしたい場合

' ========================================================
'@ 機能：全てのブック、シートに対して同じ処理をしたい場合
'@ 日付：2014.01.20
'@ 作成：D.O Revolutions エンターテイメントカレッジ
' ========================================================
Sub ExeOperationTemplate()
    On Error GoTo ERR001
    '-----------------------------------------------------
    '変数宣言
    '-----------------------------------------------------
    Dim wsSheet As Worksheet
    Dim wbCurrent As Workbook
    Dim DIR_PATH As String
    Dim fl_name As String
    '-----------------------------------------------------
    '固定値
    '-----------------------------------------------------
    Const S_TARGET_SHEET = "10桁を6桁変換"
    Const S_PATH_CELL = "C6"
    '-----------------------------------------------------
    'エクセルの保存パスを取得
    '-----------------------------------------------------
    ThisWorkbook.Activate
    ThisWorkbook.Worksheets(S_TARGET_SHEET).Activate
    DIR_PATH = ThisWorkbook.ActiveSheet.Range(S_PATH_CELL).Value
    '-----------------------------------------------------
    'アラート非表示
    '-----------------------------------------------------
    Application.DisplayAlerts = False
    '-----------------------------------------------------
    'エクセルファイルを検索
    '(無ければエラーメッセージ)
    '-----------------------------------------------------
    fl_name = Dir(DIR_PATH & "\*.xls*")
    If fl_name = "" Then
        MsgBox "Excelファイルがありません。"
        Exit Sub
    End If
    '-----------------------------------------------------
    'フォルダの全エクセルファイルを取得ループ
    '-----------------------------------------------------
    Do
        ' 現在のワークブックを取得
        Set wbCurrent = Workbooks.Open(Filename:=DIR_PATH & "\" & fl_name, UpdateLinks:=False)
        '-----------------------------------------------------
        '現在ワークブックの全シートを取得ループ
        '-----------------------------------------------------
        For Each wsSheet In wbCurrent.Worksheets
            ' カレントシートをアクティブ化
            wsSheet.Activate
            Debug.Print wsSheet.Name & "の処理中･･･"
            '★=================================================
            '★実行処理はここに記述
            '★=================================================
            '★例)シートの｛A1｝セルに"ABC"と入力したい場合★
            'wsSheet.Range("A1").Value = "ABC"
            '★=================================================
            ' 各シートの先頭セルを選択状態にする
            wsSheet.Range("A1").Select
        Next
        ' 各ブックの先頭シートを選択
        wbCurrent.Worksheets(1).Activate
        '保存して閉じる
        wbCurrent.Save
        wbCurrent.Close (True)
        '-----------------------------------------------------
        '次のエクセルを探す
        '(無ければ処理終了)
        '-----------------------------------------------------
        fl_name = Dir
    Loop Until fl_name = ""
    ' 正常終了時
    '-----------------------------------------------------
    'アラート表示
    '-----------------------------------------------------
    Application.DisplayAlerts = True
    MsgBox "正常終了"
    Exit Sub
ERR001:
    ' 異常発生時
    MsgBox "エラー番号:" & Err.Number & vbCrLf & "エラーソース:" & Err.Source & vbCrLf & _
           "エラーの種類:" & Err.Description, vbExclamation
    '-----------------------------------------------------
    'アラート表示
    '-----------------------------------------------------
    Application.DisplayAlerts = True
End Sub