エクセルVBAで既存のZIP内にファイル追加したい

質問

既存のＺＩＰファイルの中に
別の場所に保存されているフォルダを丸ごと移動したい

のですが、実現できません。

間接的に
移動したいフォルダをコピーしてＷｉｎｄｏｗｓに覚えさえ
ＺＩＰファイルをエクスプローラーで開き、
その状態で貼り付ける
という方法であれば　手動であれば追加できているのですが

この手順をＶＢＡで命令するには
どうすればいいかどなたか教えてほしいです

回答No.3

kkkkkm

No.2さんは何を勘違いしてるのでしょう？

過日の話と今回は話が違うと思いますし、Zipの中身の追加もできると思いますが…

以下参考にして
https://cheshire-wara.com/powershell/ps-cmdlets/item-file/compress-archive/

No.1の回答でCompress-Archiveでは-Updateが使える事を伝えてます。

それとも-Updateが使えなかったという事なのでしょうかね。

回答No.2

HohoPapa

VBAは、zipに圧縮されたままの状態の中身のファイルを
開くことや任意のファイル、フォルダーを追加することはできません。
これは、過日、https://okwave.jp/qa/q9965164.html
でも話題になりました。

今回の課題をVBAで実現するのであれば
・一時フォルダに解凍する
・解凍先に期待のフォルダーを複写（追加）する
・解凍先を改めてZIPに圧縮する
という作業を自前で行う必要があります。

そこで、試しに、
'https://vbabeginner.net/zip-comp-decomp/
ここにある圧縮、解凍用のコードを流用し
上記作業を行うコードを書いてみました。

よかったら参考にしてください。
なお、簡単な動作確認しか行っておらず
エラー処理も施していません。
詳しくはコードを読んでください。

Sub sample2()

　Dim wsh As Object
　Dim fso As FileSystemObject
　Dim ZipFname As String
　Dim MyTemp As String
　Dim PureFName As String
　Dim FindPoint As Long

　'格納先Zipファイルを選択し、Zipのフルパスと拡張子を除くファイル名を取得
　ZipFname = Application.GetOpenFilename(FileFilter:="圧縮ファイル,*.Zip")
　PureFName = Dir(ZipFname)
　FindPoint = InStrRev(PureFName, ".")
　PureFName = Left(PureFName, FindPoint - 1)

　'テンポラリーなフィルダーを取得
　Set wsh = CreateObject("WScript.Shell") ' インスタンス化
　MyTemp = wsh.ExpandEnvironmentStrings("%Temp%")

　'テンポラリーなフォルダーに解凍
　UnZip ZipFname, MyTemp

　'複写元フォルダーを選択し､テンポラリーなフォルダーに複写
　Set fso = New FileSystemObject ' インスタンス化
　With Application.FileDialog(msoFileDialogFolderPicker)
　　If .Show = True Then
　　　Set fso = New FileSystemObject ' インスタンス化
　　　Call fso.CopyFolder(.SelectedItems(1), MyTemp & "\" & PureFName & "\", True)
　　　Set fso = Nothing
　　Else
　　　Set fso = Nothing
　　　Exit Sub
　　End If
　End With

　'テンポラリーなフォルダーを元の場所に圧縮
　MakeZip MyTemp & "\" & PureFName, ZipFname

　'解凍先を削除
　Set fso = New FileSystemObject ' インスタンス化
　Call fso.DeleteFolder(MyTemp & "\" & PureFName, True)
　Set fso = Nothing

　MsgBox "終了"

End Sub

'https://vbabeginner.net/zip-comp-decomp/
Function UnZip(a_sZipPath As String, a_sExpandPath As String) As Boolean
　'参照設定で「Windows Script Host Object Model」を選択

　　Dim sh　　　As New IWshRuntimeLibrary.WshShell
　　Dim ex　　　As WshExec
　　Dim sCmd　　As String

　　'// 半角スペースをバッククォートでエスケープ
　　a_sZipPath = Replace(a_sZipPath, " ", "` ")
　　a_sExpandPath = Replace(a_sExpandPath, " ", "` ")

　　'// Expand-Archive：解凍コマンド
　　'// -Path：フォルダパスまたはファイルパスを指定する。
　　'// -DestinationPath：生成ファイルパスを指定する。
　　'// -Force：生成ファイルが既に存在している場合は上書きする
　　sCmd = "Expand-Archive -Path " & a_sZipPath & " -DestinationPath " & a_sExpandPath & " -Force"

　　'// コマンド実行
　　Set ex = sh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & sCmd)

　　'// コマンド失敗時
　　If ex.Status = WshFailed Then
　　　　'// 戻り値に異常を返す
　　　　UnZip = False

　　　　'// 処理を抜ける
　　　　Exit Function
　　End If

　　'// コマンド実行中は待ち
　　Do While ex.Status = WshRunning
　　　　DoEvents
　　Loop

　　'// 戻り値に正常を返す
　　UnZip = True
End Function

Function MakeZip(a_sPath As String, a_sZipPath As String) As Boolean
　　Dim sh　　　As New IWshRuntimeLibrary.WshShell
　　Dim ex　　　As WshExec
　　Dim sCmd　　As String

　　'// 半角スペースをバッククォートでエスケープ
　　a_sPath = Replace(a_sPath, " ", "` ")
　　a_sZipPath = Replace(a_sZipPath, " ", "` ")

　　'// Compress-Archive：圧縮コマンド
　　'// -Path：フォルダパスまたはファイルパスを指定する。
　　'// -DestinationPath：生成ファイルパスを指定する。
　　'// -Force：生成ファイルが既に存在している場合は上書きする
　　sCmd = "Compress-Archive -Path " & a_sPath & " -DestinationPath " & a_sZipPath & " -Force"

　　'// コマンド実行
　　Set ex = sh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & sCmd)

　　'// コマンド失敗時
　　If ex.Status = WshFailed Then
　　　　'// 戻り値に異常を返す
　　　　MakeZip = False

　　　　'// 処理を抜ける
　　　　Exit Function
　　End If

　　'// コマンド実行中は待ち
　　Do While ex.Status = WshRunning
　　　　DoEvents
　　Loop

　　'// 戻り値に正常を返す
　　MakeZip = True
End Function

回答No.1

kkkkkm

以下のサイトを参考にして試してみてください。
-Force
は
-Update
に変更し
testフォルダの中身だけをまるごとの場合
targetPath = "C:\Users\user\Desktop\test"
を( ↑ だとtestフォルダごとzipに追加されます)
targetPath = "C:\Users\user\Desktop\test\*"
にしてみてください。

【VBA】ファイル/フォルダをZIP形式で圧縮する
https://excel-vba.work/2021/12/10/%E3%80%90vba%E3%80%91%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB-%E3%83%95%E3%82%A9%E3%83%AB%E3%83%80%E3%82%92zip%E5%BD%A2%E5%BC%8F%E3%81%A7%E5%9C%A7%E7%B8%AE%E3%81%99%E3%82%8B/