获取文件夹下所有文件2
'-------------------------------------------
'フォルダーのオールエクセルファイルを取得して、
'ファイル名を変更し、シート名を変更する
'-------------------------------------------
Sub getExcelFile()
Application.ScreenUpdating = False
Dim sFolderPath As String
Dim f As String
Dim file() As String
Dim sheets_count As Integer
Dim sheet_name, new_sheet_name, old_str, new_str As String
sFolderPath = "C:\Users\ofu1\Desktop\A帳票設計書修正\設計書_SRA16"
old_str = "A16"
new_str = "A03"
ReDim file(1)
file(1) = sFolderPath & "\"
f = Dir(file(1) & "*.xls")
f = Dir
Do While f <> ""
Workbooks.Open Filename:=sFolderPath & "\" & f
With ActiveWorkbook
sheets_count = .Sheets.Count
For i = 1 To sheets_count
sheet_name = Sheets(i).Name
new_sheet_name = Replace(sheet_name, old_str, new_str)
Sheets(i).Name = new_sheet_name
Next i
End With
ActiveWorkbook.Close SaveChanges:=True
f = Dir
Loop
End Sub