<< August 2019 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 >>
SEARCH
OHERS
ADMIN
TAGS
暑い (11) , 気温 (10) , 梅雨 (7) , windows (6) , 植物 (5) , 引越 (4) , かいわれ (3) , かめ (3) , (3) , 設立 (2) , WSH (2) , VC++ (2) , VBS (2) , unix (2) , 扇風機 (2) , エアコン (2) , linux (2) , 買物 (2) , ガラス (2) , teraterm (1) , 花火 (1) , svn (1) , subversion (1) , kiq (1) , eclipse (1) , C++ (1) , vi (1) , zip (1) , sha1 (1) , win32 (1) , hash (1) , md5 (1) , (1) , (1) , 神社 (1) , お願い事 (1) , 神田 (1) , 甘酒 (1) , 靖国神社 (1) , 講習 (1) , ミスド (1) , ラーメン (1) , 風邪 (1) , 酒饅頭 (1) , 湯島 (1) , (1) , お菓子 (1) , トレッキング (1) , ドーナツ (1) , みやげ (1) , アスクル (1) , 自作 (1) , 蚊取線香 (1) , (1) ,
ARCHIVES
[VBS]Windows標準機能でZIP圧縮
Windows標準機能でZIP圧縮

Shell.ApplicationオブジェクトのCopyHere()は、ZIP圧縮の要求をかけたら終了するので、
実際にZIP圧縮が終了するまで待つ必要があります。
その為、ZIP圧縮しているポップアップウインドウの終了を待っています。



Dim workPath, zipFileName, objFSO, objFile, bs, i, strbuf

zipFileName = "C:\tmp\hogehoge\test.zip"
workPath = "C:\temp\temp20160406"

' 空のZIPファイルのヘッダ情報
bs = Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(bs)
strbuf = strbuf & Chr(bs(i))
Next

'空のZIPファイルを作成
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(zipFileName, 2, True)
objFile.Write(strbuf)
objFile.Close

'フォルダ内のファイルを全てZIPファイルに格納
CreateObject("Shell.Application").NameSpace(zipFileName).CopyHere(workPath)

Dim objShell
Set objShell = CreateObject("WScript.Shell")

Do Until (objShell.AppActivate("圧縮しています...") <> 0)
WScript.Sleep 250
Loop

Do Until (objShell.AppActivate("圧縮しています...") = 0)
WScript.Sleep 250
Loop

WScript.echo "おわり" & vbNewline



  • (2016-04-06 15:02:27)