エクセルブックの複製(.vbs)

質問

「原紙」という名前のエクセルブックがあり、新しいお客様が増えたらそのブックを複製し、更にその時にダイアログを出してお客様の名前を入力し、それをファイル名にしたいです。

下記の.vbsファイルに元ファイルをドラッグすると連番を付けて複数作る、という目的でのコマンドを見つけました（これも凄いですが）。
もし改良出来る方がいたら教えてください。

・コピー数の指定は必要ありません（毎回1ファイルのみ複製）。
・ドラッグすると、ダイアログが出てきて入力したものがファイル名になる。

よろしくお願い致します。

If WScript.Arguments.Count = 0 Then WScript.Quit

Dim fso
Set fso = CreateObject( "Scripting.FileSystemObject" )

'--- コピー元ファイルの確認
filePath = WScript.Arguments.Item(0)
If fso.FileExists( filePath ) = False Then
WScript.Echo filePath & "がありません"
WScript.Quit
End If

'--- コピー数の指定
Num = InputBox( filePath & vbNewLine & "をいくつコピーしますか")
If IsNumeric( Num ) = False Then
WScript.Echo "数値を入力してください。"
WScript.Quit
End If

If Num > 999 Or Num < 1 Then
WScript.Echo "数値は１～999で指定してください。"
WScript.Quit
End If

Extention = "." & fso.GetExtensionName( filePath )

'--- ファイルチェック
For i=1 To Num
newFilePath = Replace( filePath, Extention, "_" & Right( "000" & i, 3) & Extention )
If fso.FileExists( newFilePath ) = True Then
WScript.Echo "作成予定のファイル【" & newFilePath & "】が既に存在します。"
WScript.Quit
End If
Next

'--- ファイルコピー
For i=1 To Num
newFilePath = Replace( filePath, Extention, "_" & Right( "000" & i, 3) & Extention )
fso.CopyFile filePath, newFilePath
Next

回答No.1

Prome_Lin · ベストアンサー

単に、ファイル名を変えるだけではいけないのでしょうか？
「お客様の名前」を入力して、「原紙.xlsx」ファイルを
「お客様の名前.xlsx」にかえて、保存するのです。

もちろん、「原紙.xlsx」は、そのまま残っています。

同じフォルダにファイルが出来ますが、
これで良いのでは？

Option Explicit
Dim n, w, x, y, z
Set w = CreateObject("Scripting.FileSystemObject")
Set x = w.GetFolder(".")
Set y = CreateObject("Excel.Application")
y.Application.DisplayAlerts = False
y.Visible = False
n = InputBox("Name? ")
Set z = y.Workbooks.Open(x & "\原紙.xlsx")
z.SaveAs(x & "\" & n & ".xlsx")
z.Close
y.Quit
Set z = Nothing
Set y = Nothing
Set x = Nothing
Set w = Nothing

適当な名前を付けて「～.vbs」保存してください。

その際、「原紙.xlsx」のある同じフォルダに保存して、
あとは、ダブルクリックか、シングルクリック→リターンで
実行すると、名前を聞いてくるので、
新しいお客様の名前を入力します。

すると、「原紙.xlsx」を開いて
「新しいお客様の名前.xlsx」で
同じフォルダに保存します。