|
ExecuteExcel4Macroは、止めました。
難しすぎるんじゃないかと思います。
シート名を統一してますか?
そこまでのエラーチェック等は入れていません。
これでもエラーになると思いますが...。
Sub ボタン1_Click()
Dim FldName As String, FalName As String, OPWBk As Workbook
Dim ReNameSt As String
Application.ScreenUpdating = False
FldName = "C:\work\台帳\"
FalName = Dir(FldName)
Do Until FalName = ""
If Right(FalName, 3) = "xls" Or Right(FalName, 3) = "XLS" Then
Cnt = Cnt + 1
Set OPWBk = Workbooks.Open(FldName & FalName)
ReNameSt = OPWBk.Sheets("農道台帳(調書)").Range("N4").Value
OPWBk.Close (False)
DoEvents
Name FldName & FalName As FldName & Format(ReNameSt, "000") & ".xls"
FalName = Dir()
End If
Loop
If Cnt = 0 Then
MsgBox "対象ファイルがありません"
End If
Application.ScreenUpdating = True
Set OPWBk = Nothing
End Sub
|
|