以前公開したこの記事が意外と人気で、どういった検索ワードでこの記事に辿り着いているのか調べた時に、結構「vba outlook zip」というワードがあったので、結構需要があるのかなと思い、この記事を作成しています。
今回は、ファイルをzip化してメールに自動で添付する方法をご紹介します。
最初に断っておきますが、今回紹介するのはzip化するだけです。
パスワードの設定は諸々大変そう&会社のパソコンでは実現が難しそうだった(アプリのインストール?)ため、今回は紹介ありません。その点はご了承ください。
このコードの使用は自己責任でお願いします。
目次
マクロでzip化する前の準備
マクロでファイルのzip化をする場合、少しだけ準備が必要です。
それはライブラリの追加。
20秒で終わるので安心を。
ツール→参照設定を選択

windows Script Host Object Modelを選択

これだけで準備は完了です。
今回紹介するコード全文
今回は以前紹介したマクロを使ってメールを自動送信する方法のコードをベースにしています。
その記事をまだ確認されていない人はこちらの記事から確認をお願いします。
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 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 |
Sub Outlook_zip() Dim oApp Dim Wm_ITEM Dim Wm_TO Set oApp = GetObject(, "Outlook.Application") ''↑↑ガン無視↑↑ Dim folder As String Dim FileName As String Dim row As Long Dim shname As String row = 2 shname = "メール _いっぱいver" Do Until row = 5 '★★メール画面を開く Set Wm_ITEM = oApp.CreateItem(0) Wm_TO = "" WS_OutLk = "" If ThisWorkbook.Sheets(shname).Cells(row, 1) <> "" Then '★★宛先、CC、件名、本文を入力してるだけ★★ Wm_ITEM.To = ThisWorkbook.Sheets(shname).Cells(row, 5) '宛先 Wm_ITEM.CC = ThisWorkbook.Sheets(shname).Cells(row, 6) 'CC Wm_ITEM.Subject = ThisWorkbook.Sheets(shname).Cells(row, 7) '件名 Wm_ITEM.Body = ThisWorkbook.Sheets(shname).Cells(row, 3) & _ ThisWorkbook.Sheets(shname).Cells(row, 4) '社名+宛先名 Wm_ITEM.Body = Wm_ITEM.Body _ & vbCrLf _ & ThisWorkbook.Sheets(shname).Cells(row, 8) '社名+宛先名+本文 '★★ファイル添付★★ Dim inp As String Dim msg As String Dim Path As String Dim Zippath As String Dim Result As Boolean folder = ThisWorkbook.Sheets(shname).Cells(row, 9).Value '添付したいファイルの場所 FileName = ThisWorkbook.Sheets(shname).Cells(row, 10).Value '添付したいファイル名 Path = folder & "\" & FileName msg = "zip化した後の名前を入力(拡張子なし)" & vbCrLf & _ "zip前⇒" & FileName inp = InputBox(msg) Zippath = folder & "\" & inp & ".zip" Result = MakeZip(Path, Zippath) Wm_ITEM.Attachments.Add Zippath 'ファイル添付 Wm_ITEM.Display '.displayで 表示 '★★メール保存or送信★★慣れるまでは保存推奨!! Wm_ITEM.Save '.Saveで保存下書きへ ' Wm_ITEM.Send '.Sendで送信※コメントを外すと送信されます End If row = row + 1 Loop MsgBox "かんりょ" End Sub |
1 2 3 4 5 6 7 8 9 10 11 |
Function MakeZip(a_Path As String, a_Zippath As String) As String Dim sh As New IWshRuntimeLibrary.WshShell Dim ex As WshExec Dim Cmd As String Cmd = "Compress-Archive -Path " & a_Path & " -DestinationPath " & a_Zippath & " -Force" Set ex = sh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & Cmd) MakeZip = True End Function |
ファイルをzip化するマクロ

今回はファイルを添付する前に、そのファイルをzip化しています。
具体的にzip化している箇所は↓の場所です。
1 |
Result = MakeZip(Path, Zippath) |
の場所からfunction MakeZipに飛びます。
1 2 3 4 5 6 7 8 9 10 11 |
Function MakeZip(a_Path As String, a_Zippath As String) As String Dim sh As New IWshRuntimeLibrary.WshShell Dim ex As WshExec Dim Cmd As String Cmd = "Compress-Archive -Path " & a_Path & " -DestinationPath " & a_Zippath & " -Force" Set ex = sh.Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & Cmd) MakeZip = True End Function |
正直ごちゃごちゃ書いてあって、私もすべては理解できていませんが重要な点は
Result=MakeZip(Path,Zippath)のpathをZippathとしてzipファイルで保存するということだけです。
もっと詳しいことを知りたい人はネットで調べてください。
そもそもzip化ってどういう時に使うん?
あんまり業務でzip化って使わないんですけど、どういう時に使うんですかね。
パスワードがついたzipだったら、取引先からのメールでよくついていますが、パスワードがついていないzipってどういった場面で登場するのでしょうか。
容量も別にそこまで圧縮されないし謎です。