vbs経由でttl実行

vbsファイルを実行するとカレントのttlファイルを実行する

' =================================================
' 処理の流れ
' オブジェクトの宣言
' ↓
' ttlの実行
' ↓
' カレント内に ttlファイル名の圧縮フォルダを作成
' ↓
' 更新2分以内のダウンロードしたファイル(1file)を
' 作成したフォルダへ移動させて、password付きでzipする
' ↓
' zipしたエクスプローラを開く
' ↓
' オブジェクトの破棄
' =================================================

Option Explicit   ' 厳格化

' =================================================
' オブジェクトの宣言
' =================================================
Dim objWshShell     ' WScript.Shell
Dim objFSO          ' FileSystemObject
Dim objDownPath     ' ダウンロードフォルダのフルパス(オブジェクト)
Dim objDownFilename ' ダウンロードフォルダ内ファイル名(オブジェクト)
Dim objShell        ' Shell.Application


' ===========================================
' ttlの実行
' ===========================================
Dim ttlFileName   ' ttlファイル名
Dim res           ' ダイアログ分岐用
Dim curreFolPath  ' カレントのフルパス
Dim teraExePath   ' 実行ファイルのフルパス
Dim ttlPath       ' ttlファイルのフルパス

' ※注意点
'   ↓↓必要に応じてttlファイルを変更する↓↓
ttlFileName = "test.ttl"

Call ttlRun(ttlFileName)
Sub ttlRun(ttlFileName)
	Set objWshShell = WScript.CreateObject("WScript.Shell")
	' カレントのフルパスを取得
	curreFolPath = objWshShell.CurrentDirectory
	' 実行ファイルのフルパスを取得
	teraExePath = """c:\Program Files (x86)\teraterm\ttpmacro.exe"""
	' ttlファイルのフルパスを取得
	ttlPath = curreFolPath &"\"& ttlFileName
	' ttlファイルの実行判定
	res = MsgBox(ttlPath & vbCR & vbCR & "の実行を開始しますか？",33)
	If res = vbCancel Then
	   WScript.Quit
	End If
	' ttlファイルの実行
	objWshShell.Run teraExePath &" "& ttlPath, 1, True
End Sub


' ==============================================
' カレント内に ttlファイル名の圧縮フォルダを作成
' ==============================================
Dim packFolName ' 圧縮フォルダ名
Dim packFolPath ' 圧縮フォルダのフルパス

Call createPackFolder()
Sub createPackFolder
	Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
	' 拡張子無しのttlファイル名を取得
	packFolName = objFSO.getBaseName(ttlPath)
	' 圧縮フォルダのフルパスを取得
	packFolPath = curreFolPath &"\"& packFolName
	' 圧縮フォルダが存在しない場合、新規作成する
	If objFSO.FolderExists(packFolPath) = False Then
	   objFSO.CreateFolder(packFolPath)
	End If
End Sub


' ======================================================================
' 更新2分以内のダウンロードしたファイル(1file)を圧縮フォルダへ移動させる
' ======================================================================
Dim deskTopFolPath  ' デスクトップのフルパス
Dim downFolPath     ' ダウンロードフォルダのフルパス
Dim downFiles       ' ダウンロードフォルダ内ファイル名(配列カウント用)
Dim sysDate         ' システム日付
Dim upDateTime      ' 更新日時
Dim dlFileNamePath  ' 更新日時2分以内のファイルのフルパス
Dim downFileName    ' ダウンロードファイル名

' デスクトップのフルパスを取得
deskTopFolPath = objWshShell.SpecialFolders("desktop")

' ダウンロードフォルダのフルパスを取得
' ※注意点
'   ↓↓必要に応じてダウンロードフォルダ名を変更する↓↓
downFolPath = deskTopFolPath & "\" & "down"

' ダウンロードフォルダのフルパスをオブジェクトにセット
Set objDownPath = objFSO.GetFolder( downFolPath ) 

'システム日付を取得(yyyyMMdd)
sysDate = Now()

' 更新２分以内のダウンロードファイル(1File)を圧縮フォルダへ移動する
For each downFiles in objDownPath.Files
    downFileName = downFiles.name
    Set objDownFilename = downFiles
    '更新日時を取得
    upDateTime = objDownFilename.datelastmodified
    If DateDiff("n", upDateTime, sysDate) < 2 Then
       objFSO.MoveFile downFiles, packFolPath & "\" & downFileName
       Exit For
    End if
Next


' =================================================
' ダウンロードしたファイルをpassword付きでzip化する
' =================================================
Dim packExePath     ' 圧縮実行ファイルのフルパス
Dim packOpt         ' 圧縮時のオプションと引数

'圧縮実行ファイルのフルパスを代入
' ※注意点
'   ↓↓必要に応じて実行ファイルのパスを変更する↓↓
packExePath = """c:\Program Files\test.exe"""

' オプションと引数を代入する
' パス内に半角スペースがあると正しく値が取れないため
' Chr(34)を使用している
' ※注意点
'   ↓↓パスワードは必要に応じて変更する↓↓
packOpt = "/c:zip /p:PASSWORD " & Chr(34) & packFolPath & "\" _
        & downFileName & Chr(34)

' 圧縮を実行します。
objWshShell.Run packExePath &" "& packOpt, 1, True


' ==========================
' zipしたエクスプローラを開く
' ==========================
Dim zipFolPath   ' zipしたフォルダのフルパス

Call ExploreOpen()
Sub ExploreOpen
	zipFolPath = packFolPath
	Set objShell = WScript.CreateObject("Shell.Application")

	' zipしたエクスプローラを開きます
	objShell.Explore zipFolPath
End Sub


' =================
'オブジェクトの破棄
' =================
Set objDownPath = Nothing
Set objFSO = Nothing
Set objDownFilename = Nothing
Set objWshShell = Nothing
Set objShell = Nothing