Unzip File In Outlook (either compose or Message Received Window) (Public)

PHOTO EMBED

Fri Aug 06 2021 07:02:12 GMT+0000 (Coordinated Universal Time)

Saved by @cnewnham #vba

Public Sub UnzipFileInOutlook() 'Used to unzip files in an outlook message in the compose window or message received window 

    Dim objMail As Outlook.MailItem 

    Dim objAttachments As Outlook.Attachments 

    Dim objAttachment As Outlook.Attachment 

    Dim objShell As Object 

    Dim objFileSystem As Object 

    Dim strTempFolder As String 

    Dim strFilePath As String 

    Dim strFileName As String 

  

    Set objMail = Outlook.Application.ActiveInspector.CurrentItem 

    Set objAttachments = objMail.Attachments 

  

    'Save & Unzip the zip file in local drive 

    Set objShell = CreateObject("Shell.Application") 

    Set objFileSystem = CreateObject("Scripting.FileSystemObject") 

    strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\Temp" & Format(Now, "yyyy-mm-dd-hh-mm-ss") 

    MkDir (strTempFolder) 

  

    For Each objAttachment In objAttachments 

        If Right(objAttachment.FileName, 3) = "zip" Then 

           strFilePath = strTempFolder & "\" & objAttachment.FileName 

           objAttachment.SaveAsFile (strFilePath) 

           objShell.NameSpace((strTempFolder)).CopyHere objShell.NameSpace((strFilePath)).Items 

        End If 

    Next 

  

    'Reattach the files extracted from the zip file 

    strFileName = Dir(strTempFolder & "\") 

  

    While Len(strFileName) > 0 

          objMail.Attachments.Add (strTempFolder & "\" & strFileName) 

          strFileName = Dir 

          objMail.Save 

    Wend 

  

    'Delete the attachments in “.zip” file extension 

    Set objAttachments = objMail.Attachments 

    For Each objAttachment In objAttachments 

        If Right(objAttachment.FileName, 3) = "zip" Then 

           objAttachment.Delete 

           objMail.Save 

        End If 

    Next 

  

    'Delete the temp folder and files 

    objFileSystem.DeleteFolder (strTempFolder) 

End Sub 
content_copyCOPY