获取文件夹下所有文件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

posted @ 2017-04-07 16:41  Ouka傅  阅读(144)  评论(0编辑  收藏  举报