ttl実行後、対象ファイルをzipして移動後、エクスプローラを開くVBS

' =================================================
' 処理の流れ
' オブジェクトの宣言
' ↓
' ttlの実行
' ↓
' カレント内に ttlファイル名のフォルダを作成
' ↓
' ダウンロードフォルダ内のファイルを圧縮フォルダへ移動する
' ↓
' 圧縮フォルダ内のファイルをpassword無しでzip化する
' ↓
' zipファイルを別フォルダへ移動させる
' ↓
' 移動先フォルダを開く
' ↓
' オブジェクトの破棄
' =================================================

Option Explicit   ' 厳格化

' =================================================
' オブジェクトの宣言
' =================================================
Dim objWshShell      ' WScript.Shell
Dim objFSO           ' FileSystemObject
Dim objDownPath      ' ダウンロードフォルダのフルパス(オブジェクト)
Dim objTeraFol       ' TeraTermLogのフルパス(オブジェクト)
Dim objTeraFileName  ' TeraTermLogファイル名(オブジェクト)
Dim objOutFile       ' 圧縮対象のファイルリスト(オブジェクト)
Dim objPackFolPath   ' packフォルダのフルパス(オブジェクト)
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


' ========================================================
' ダウンロードフォルダ内のファイルを圧縮フォルダへ移動する
' ========================================================
Dim deskTopFolPath  ' デスクトップのフルパス
Dim downFolPath     ' ダウンロードフォルダのフルパス
Dim downFiles       ' ダウンロードフォルダ内のファイル名(配列カウント用)
Dim strExtension    ' 拡張子
Dim downFileName    ' ファイル名

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

' ダウンロードフォルダのフルパスをオブジェクトにセット
Set objDownPath = objFSO.GetFolder( downFolPath ) 
'
' ダウンロードフォルダ内のsql以外のファイルを圧縮フォルダへ移動
For each downFiles in objDownPath.Files

   'ファイルの拡張子を取得する
   strExtension = objFSO.GetExtensionName(downFiles)
   downFileName = downFiles.name
   If strExtension <> "sql" then
      objFSO.MoveFile downFiles, packFolPath & "\" & downFileName
   End If

Next


' =================================================
' 圧縮フォルダ内のファイルをpassword無しでzip化する
' =================================================
Dim tmpFilelistPath  ' 圧縮対象のファイルリストのフルパス
Dim packFile         ' packファイル(配列カウント用)
Dim packExePath      ' 圧縮実行ファイルのフルパス
Dim packOpt          ' 圧縮時のオプションと引数
Dim strFormattedDate ' yyyymmdd形式の日時

' デスクトップに圧縮対象リストファイルを一時的に作成
tmpFilelistPath = deskTopFolPath & "\filelist.tmp"
'ファイルリストを書き込みモードでオープン
Set objOutFile = objFSO.OpenTextFile(tmpFilelistPath,2,true)
' 圧縮フォルダのフルパスをオブジェクトへセット
Set objPackFolPath = objFSO.GetFolder( packFolPath )
' 圧縮フォルダ内のファイルをリストに書込み
For each packFile in objPackFolPath.Files
    objOutFile.WriteLine packFile
Next
'ファイルリストのクローズ
objOutFile.Close

' zipファイル名にyyyymmdd 形式を含めるため取得
strFormattedDate = Replace(Left(Now(),10), "/", "")

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

' オプションと引数を packOpt へ代入する
' パス内に半角スペースがあると正しく値が取れないためChr(34)を使用している
' /n 圧縮zip名
' ※注意点
'   ↓↓ファイル名は必要に応じて変更する↓↓
packOpt = "/c:zip /n:" & Chr(34) & packFolPath & _
          "\" & strFormattedDate & "_test.zip" & Chr(34) & _
          " /l:" & tmpFilelistPath & " /d"

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


' ===================================
' zipファイルを別フォルダへ移動させる
' ===================================
Dim zipFilePath    ' zipファイルのフルパス
Dim destFilePath   ' 移動先フォルダ名

' zipファイルのフルパスを取得
zipFilePath = packFolPath & "\" & strFormattedDate & "_test.zip"
' 移動先のフォルダのフルパスを取得
' 必要に応じて変更する
destFilePath = deskTopFolPath & "\testFolder\"

objFSO.MoveFile zipFilePath, destFilePath


' ======================
' 移動先フォルダを開く
' ======================
Call ExploreOpen()
Sub ExploreOpen
    Set objShell = WScript.CreateObject("Shell.Application")

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


' =================
'オブジェクトの破棄
' =================
Set objTeraFol = Nothing
Set objTeraFileName = Nothing
Set objDownPath = Nothing
Set objFSO = Nothing
Set objWshShell = Nothing
Set objShell = Nothing
Set objOutFile = Nothing
Set objPackFolPath = Nothing