- outlookで受信したメールに添付されているzipファイルを任意のフォルダに格納する。
- 格納したzipファイルを解凍する（パスワード付の場合は予め決められたパスワードを使う）
- zipファイル解凍には7zipのdllを用いる。
事前準備
64bit OS (Windows8等）
- http://www.madobe.net/archiver/index.html から7-ZIP32.DLL をダウンロード
- 「7-zip32.dll」を「C:\Windows\SysWOW64」に格納する。
32bit OS (Windows XX)
- http://www.madobe.net/archiver/index.html から7-ZIP32.DLL をダウンロード
- 「7-zip32.dll」を「C:\Windows\System32」に格納する。
コード
saveZip.vba
Option Explicit
Private Declare Function SevenZip Lib "7-zip32.DLL" ( _
ByVal hWnd As Long, _
ByVal szCmdLine As String, _
ByVal szOutput As String, _
ByVal dwSize As Long) As Long
Const SAVE_PATH = "C:\mail_attach\"
Public Sub CustomRule_SaveFile(Item As Outlook.MailItem)
Dim SaveStatus
SaveStatus = SaveAttachFile(Item.Attachments)
End Sub
Function SaveAttachFile(Attachments As Outlook.Attachments)
Dim UnzipStatus
Dim sh As Object
Dim ItemNumber, i As Long
ItemNumber = Attachments.Count
For i = 1 To ItemNumber
Attachments.Item(i).SaveAsFile (SAVE_PATH & Attachments.Item(i).DisplayName)
UnzipStatus = ExtractZIP(SAVE_PATH, SAVE_PATH & Attachments.Item(i).DisplayName, "test")
Next i
SaveAttachFile = True
End Function
'ZIPファイルを解凍
'引数 sDstPath：解凍先のフォルダーのパス
' sZIPFile：ZIPファイルのパス
' sPassWord：パスワード 省略可
'返り値 成功したら True、失敗したらFalse
Public Function ExtractZIP(sDstPath As String, sZIPFile As String, Optional sPassWord As String = "") As Boolean
Dim sCmd As String
sCmd = "X -hide -aoa "
If sPassWord <> "" Then sCmd = sCmd & "-P" & sPassWord & " "
sCmd = sCmd & Q2(sZIPFile) & " -o" & Q2(sDstPath)
Debug.Print (sCmd)
ExtractZIP = DoSevenZip(sCmd) = 0
End Function
Private Function DoSevenZip(sCmd As String) As Long
Dim sRet As String * 1024
DoSevenZip = SevenZip(0, sCmd, sRet, 1024)
If DoSevenZip <> 0 Then MsgBox (Left(sRet, InStr(sRet, vbNullChar) - 1))
End Function
Public Function Q2(ByVal Text As String) As String
Q2 = """" & Replace(Text, """", """""") & """"
End Function