vbsでttl自動実行後、ダウンロードした複数ファイルを圧縮する

' =================================================
' 処理の流れ
' オブジェクトの宣言
' ↓
' ttlの実行
' ↓
' カレント内に ttlファイル名の圧縮フォルダを作成
' ↓
' ダウンロードフォルダ内のファイルを圧縮フォルダへ移動する
' ↓
' TeraTermLogを圧縮フォルダへコピーする
' ↓
' ファイルを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


' =====================================
' TeraTermLogを圧縮フォルダへコピーする
' =====================================
Dim teraFolPath      ' TeraTermLogのフルパス
Dim TeraFile         ' TeraTermLog(配列カウント用)
Dim sysDate          ' システム日付
Dim upDateTime       ' テラログの更新日時
Dim teraFileName     ' TeraTermLog ファイル名

' TeraTermLog のフルパスを代入
' ※注意点
'   ↓↓必要に応じてパスを変更します↓↓
teraFolPath = deskTopFolPath & "\" & "teratermlog"
'システム日付を取得(yyyyMMdd)
sysDate = Now()

' TeraTermLogフォルダ名をオブジェクトへセット
Set objTeraFol = objFSO.GetFolder( teraFolPath )

For each TeraFile in objTeraFol.Files
    teraFileName = TeraFile.name
    'File名をオブジェクト変数へセット
    Set objTeraFileName = TeraFile
    
    '更新日時を取得
    upDateTime = objTeraFileName.datelastmodified

    '更新日時が100秒以内の場合、圧縮フォルダへコピーする
    If DateDiff("s", upDateTime, sysDate) < 100 Then
        objFSO.CopyFile TeraFile, packFolPath & "\" & teraFileName
    End if
Next

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

' デスクトップに圧縮対象リストファイルを一時的に作成
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

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

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

' 圧縮を実行します。
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 objTeraFol = Nothing
Set objTeraFileName = Nothing
Set objDownPath = Nothing
Set objFSO = Nothing
Set objWshShell = Nothing
Set objShell = Nothing
Set objOutFile = Nothing
Set objPackFolPath = Nothing