Option Explicit


 


'ドラッグドロップ
Dim objArgs : Set objArgs = WScript.Arguments   '入力
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strFolder, strFile, strPath, strExt
Dim cnt, stText




If objArgs.Count <> 1 Then
    call errorEnd("入力は１ファイルのみです")
Else
    strPath = objArgs(0)
    If objFSO.FolderExists(strPath) Then
        call errorEnd("入力は１ファイルのみです")
    ElseIf objFSO.FileExists(strPath) Then
		call add_text2filename(strPath)
	End If
End If


 


'ファイルに対するメイン処理


 


Sub add_text2filename(file)
Dim objFSO, objShell, BKUPpath, fileName, fileExt, pos, backupName, note
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")

' BKUPフォルダのパスを設定
BKUPpath = objFSO.GetParentFolderName(file) & "\BKUP"

' BKUPフォルダが存在しない場合は作成
If Not objFSO.FolderExists(BKUPpath) Then
    objFSO.CreateFolder(BKUPpath)
End If

' ファイル名と拡張子を分割
fileName = objFSO.GetBaseName(file)
fileExt = objFSO.GetExtensionName(file)

' メモを入力
note = InputBox("ファイル名に記載する更新内容を入力してください。", "更新内容は？")

' バックアップファイル名を作成
dim date
date=Replace(now, "/", "") 
date=Replace( date , ":" , "" )
date=Replace( date , " " , "_" )
date=left(date , 13)
If note = "" Then
    backupName = BKUPpath & "\" & fileName & "_" & date & "_UPDT." & fileExt
Else
    backupName = BKUPpath & "\" & fileName & "_" & date & "_UPDT(" & note & ")." & fileExt
End If
msgbox backupName
' ファイルをコピー
objFSO.CopyFile file, backupName

' オブジェクトを解放
Set objFSO = Nothing
Set objShell = Nothing


 


End Sub