エクセルVBA 日付つきバックアップファイル

質問

下記のような連番でバックアップファイルを作成するマクロを書きました。バックアップファイルの最上部に行を挿入し、そこにバックアップファイルの作成日とオリジナルのFullName(フルパス)を記したいのですがうまくいきません。

.Range("a1") = "保存時刻 ： " & Format(Now, "yyyy年mm月dd日hh時nn分")
.Range("a2") = "オリジナル ： " & ActiveWorkbook.FullName
↑のような感じの情報を加えたいのです。

どなたか、下記のマクロにフルパスと作成日を付与し、マクロ実行後も作業中のブックをアクティブのままにして置く方法をおしえてください。

Sub MySave2()

Dim FSO As New Scripting.FileSystemObject
バックアップファイル名 = "C:\My Documents\エクセルBackUpｓ\" & Format(Date, "yyyymmdd") _
& ActiveWorkbook.Name

If FSO.FileExists(バックアップファイル名) = False Then
ActiveWorkbook.SaveCopyAs バックアップファイル名

Else
Dim indn As Variant
For indn = 2 To 1000
新 = "C:\My Documents\エクセルBackUpｓ\" & Format(Date, "yyyymmdd") _
& "-" & indn & ActiveWorkbook.Name

If FSO.FileExists(新) = False Then
ActiveWorkbook.SaveCopyAs 新
Exit For
Else
End If

Next indn
End If

End Sub

回答No.1

めとろいと（@naktak） · ベストアンサー

何をしたいか良く掴めませんでしたが、以下のような事で良いのでしょうか？

Sub MySave2()
Dim pObjFSO As Object
Dim pStrOriginPath As String
Dim pStrNewPath As String
Dim pLngINDN As Long

Set pObjFSO = CreateObject("Scripting.FileSystemObject")

pStrOriginPath = "C:\Documents and Settings\Administrator\デスクトップ\" & _
Format(Date, "yyyymmdd") & ActiveWorkbook.Name

If pObjFSO.FileExists(pStrOriginPath) = False Then
ActiveWorkbook.SaveCopyAs pStrOriginPath

Else
pLngINDN = 2
Application.ScreenUpdating = False
Do While (True)
pStrNewPath = "C:\Documents and Settings\Administrator\デスクトップ\" & _
Format(Date, "yyyymmdd") & "-" & pLngINDN & ActiveWorkbook.Name

If pObjFSO.FileExists(pStrNewPath) = False Then
Range("A1").Value = "保存時刻：" & Format(Now, "yyyy年mm月dd日hh時nn分")
Range("A2") = "オリジナル ： " & ActiveWorkbook.FullName
ActiveWorkbook.SaveCopyAs pStrNewPath
Exit Do
End If
pLngINDN = pLngINDN + 1
Loop

Range("A1").Value = ""
Range("A2") = ""
Application.ScreenUpdating = True
End If

End Sub