EXCEL changeheadformat

'Option Explicit
Private strFileName As String
Private mstrDir As String
Private colAllDir() As New Collection
Private mintCount As Integer
Private mFileName(800) As String
        
Private Sub Change_Click()

    Dim i As Integer
    Dim j As Integer

    scan (Text1.Text & "\")
   
    If mintCount = -1 Then
        MsgBox "File Path Error!", vbOKOnly, "メッセージ"
        Exit Sub
    End If
   
    ProgressBar1.Min = 0
    ProgressBar1.Max = mintCount + 1
    ProgressBar1.Visible = True
    List1.Clear
   
    For i = 0 To mintCount
       
        Set ObjExcelApl = Nothing
        j = 1
           
        Set ObjExcelApl = CreateObject("Excel.Application")         'エクセルを開く
        ObjExcelApl.Workbooks.Open mFileName(i)             'ブックを開く
       
        For j = 1 To ObjExcelApl.Worksheets.Count
           
                ObjExcelApl.Worksheets.Item(j).Activate
                   
                lblSheetCount.Caption = mFileName(i) & vbCrLf & ObjExcelApl.ActiveSheet.Name
          

;          
                    
                    If InStr(ObjExcelApl.ActiveSheet.Name, "外部定義") > 0 Then
                        ObjExcelApl.ActiveSheet.Range("G4").Value = "蔣中平系統名字"
                    Else
                        ObjExcelApl.ActiveSheet.Cells(3, 12) = "蔣中平系統名字"
                    End If
                   
                    '印刷設定
                    With ObjExcelApl.ActiveSheet.PageSetup
                        .LeftHeader = "&""ＭＳ 明朝,標準" & Chr$(34) & "&10 "
                        .RightHeader = "&""ＭＳ 明朝,標準" & Chr$(34) & "&22 " & "ffffffffffddd"
                       
                        .RightFooter = "&""ＭＳ 明朝,

標準" & Chr$(34) & "&22 &資料番號　BDDDSAFSFASFAF　"
                   
                    End With
                   
                    ObjExcelApl.ActiveSheet.Range("A1").Select
                   
               
        Next j
       
            ObjExcelApl.Worksheets.Item(1).Select
            ObjExcelApl.ActiveWorkbook.Save
            ObjExcelApl.ActiveWindow.Close
                        

            List1.AddItem mFileName(i)
            ProgressBar1.Value = i + 1
           
    Next i
   
    MsgBox "全てのファイルを修正しました。", vbOKOnly, "確認"
   
End Sub

Private Sub Close_Click()
End
End Sub

Private Sub Form_Load()
    mintCount = -1
End Sub

Sub scan(strDir As String)
  Dim strFileName     As String
  Dim nd     As Integer
  Dim fold()     As String
  Dim n     As Integer
 
  Dim strTmpDir As String
  Dim strTmpDirSec() As String
 
  strFileName = Dir(strDir, vbDirectory)
  Do While strFileName <> ""
          If strFileName <> "." And strFileName <> ".." Then
                  If GetAttr(strDir & strFileName) = vbDirectory Then
                          nd = nd + 1
                          ReDim Preserve fold(nd)
                          fold(nd) = strDir & strFileName
                  Else
                 
                        If strDir <> mstrDir Then
                       
                            If Right(strFileName, 4) = ".xls" Then
                                mintCount = mintCount + 1
                                mFileName(mintCount) = strDir & strFileName
       

;                                                       
                            End If
                           
                        End If
                  End If
          End If
          strFileName = Dir
          DoEvents
  Loop
   
  strFileName = Dir(strDir)
  Do While strFileName <> ""
          strFileName = Dir
  Loop
   
  For n = 1 To nd
        Call scan(fold(n) & "\")
  Next
           
End Sub