Consulting

Results 1 to 14 of 14

Thread: (Rule) save attachment then extract using 7zip

  1. #1

    (Rule) save attachment then extract using 7zip

    Hi

    I am trying to create a script in Outlook that runs on all new messages with attachment.
    I want it to :

    1. save attachment (I know it will be a password protected zip file)
    2. extract contents of zip file using 7zip to specofic location

    I've been fiddling with the following code, but I can't seem to get it to work.. it does save the attachment but it doesn't extract the contents.. sometimes I can get it to extract but 7zip prompts every time that the file exists and would I like to overwrite it/Quit etc. even though I am 100% sure the target file isn't in the location..
    I regret to admit that I have NO knowledge about VBA.. at all.. I usually work in Powershell... The below code I gleaned from the internet and just kindda tried stuff.. :-)
    I am hoping someone will correct the code so I have a usable script..

    here's the code:

    Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    saveFolder = "c:\temp"
    Dim objShell As Object
    
        Set objShell = CreateObject("Wscript.Shell")
         For Each objAtt In itm.Attachments
              objAtt.SaveAsFile saveFolder & "\" & objAtt.FileName
              objShell.Run """C:\Program Files\7-Zip\7z.exe"" e -aoap56suwBfbNd & saveFolder & " \ " & objAtt.FileName & """""
              Set objAtt = Nothing
              Set objShell = Nothing
         Next
    End Sub

  2. #2
    You are going to need something a little more complex. The major problem for doing this automatically is the password. Is the password always going to be the same for each zip attachment?

    How are you going to identify the messages that have the password as opposed to other messages with zip attachments that are not password protected, because if you send the wrong password Z-Zip will not extract the contents.

    The following can be used to extract messages with zip attachments, whether they are password protected or not, but you are going to have to tell the process what the password is or enter it at the prompt. If there is no password set the password to a null string.

    Make sure that the code correctly locates the Z-Zip folder. the location shown is from my PC. If the password is the same for all zips, hard code the password instead of using the input box.

    If you are going to run the main code from a rule, you will have to ensure that the rule correctly identifiues the incoming messages.

    I have included error trapping to ensure that no extracted folders are overwritten, and a test macro so that you can test the process with messages in your inbox.

    I have also included alternative code that does not use Z-Zip (but it will not address password protected Zips either). This is for the benefit of others who may later access the thread.

    Option Explicit
    
    Sub TestUnzip()
    'An Office macro by Graham Mayor - www.gmayor.com
    Dim olMsg As MailItem
        'On Error Resume Next
        Set olMsg = ActiveExplorer.Selection.Item(1)
        UnzipAttachments olMsg
    lbl_Exit:
        Exit Sub
    End Sub
    
    Sub UnzipAttachments(Item As Outlook.MailItem)
    'An Outlook macro by Graham Mayor - www.gmayor.com
    Dim olAtt As Attachment
    Dim strFileName As String
    Dim strPath As String
    
    strPath = Environ("Temp") & "\ZipTemp"       'Folder to save temporary files
        If Item.Attachments.Count > 0 Then
            For Each olAtt In Item.Attachments
                If Right(LCase(olAtt.FileName), 3) = "zip" Then
                    CreateFolders strPath
                    olAtt.SaveAsFile strPath & olAtt.FileName
                    'UnZipFile strPath & olAtt.FileName
                    UnzipWithPassword strPath & olAtt.FileName
                    Kill strPath & olAtt.FileName
                End If
            Next olAtt
        End If
    lbl_Exit:
        Set olAtt = Nothing
        Exit Sub
    End Sub
    
    Private Sub UnzipWithPassword(fname As Variant)
    Dim FSO As Object
    Dim oApp As Object
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim strDate As String
    Dim sPathTo7ZipExe As String
    Dim sZipPassword As String
    Const strFolder As String = "C:\Path\Unzipped"
        sPathTo7ZipExe = "C:\Program Files (x86)\7-Zip\7z.exe"
        sZipPassword = InputBox("Enter ZIP Password", "Unzip Files") '"asdfasdf"  ' zip password
    
        'Create the folder name
        strDate = Format(Now, " dd-mm-yy")
        FileNameFolder = FolderNameUnique(strFolder & strDate & "\")
    
        'Make the normal folder in DefPath
        CreateFolders CStr(FileNameFolder)
    
        Shell sPathTo7ZipExe & " x -y -p" & sZipPassword & " -o""" & _
              FileNameFolder & """ """ & fname, vbHide
    
        MsgBox "You find the files here: " & FileNameFolder
    lbl_Exit:
        Exit Sub
    End Sub
    
    Private Sub UnZipFile(fname As Variant)
    'An Office macro by Graham Mayor - www.gmayor.com
    Dim FSO As Object
    Dim oShell As Object
    Dim FileNameFolder As Variant
    Dim strDate As String
    Const strFolder As String = "C:\Path\Unzipped"
    
        'Create the folder name
        strDate = Format(Now, " dd-mm-yy")
        FileNameFolder = FolderNameUnique(strFolder & strDate & "\")
    
        'Make the normal folder in DefPath
        CreateFolders CStr(FileNameFolder)
        
        'Extract the files into the newly created folder
        Set oShell = CreateObject("Shell.Application")
        oShell.NameSpace(FileNameFolder).CopyHere oShell.NameSpace(fname).Items
        MsgBox "You will find the unzipped file(s) here: " & FileNameFolder
    lbl_Exit:
        Set FSO = Nothing
        Set oShell = Nothing
        Exit Sub
    End Sub
    
    Private Function CreateFolders(strPath As String)
    'An Office macro by Graham Mayor - www.gmayor.com
    Dim strTempPath As String
    Dim lngPath As Long
    Dim vPath As Variant
        vPath = Split(strPath, "\")
        strPath = vPath(0) & "\"
        For lngPath = 1 To UBound(vPath)
            strPath = strPath & vPath(lngPath) & "\"
            If Not FolderExists(strPath) Then MkDir strPath
        Next lngPath
    lbl_Exit:
        Exit Function
    End Function
    
    Private Function FolderNameUnique(strPath As String) As String
    'An Office macro by Graham Mayor - www.gmayor.com
    'Requires the use of the FolderExists function
    Dim lngF As Long
    Dim lngName As Long
    Dim strPathName As String
    Dim bSlash As Boolean
        If Right(strPath, 1) = Chr(92) Then
            strPath = Left(strPath, Len(strPath) - 1)
            bSlash = True
        End If
        lngF = 1
        strPathName = strPath
        Do While FolderExists(strPath) = True
            strPath = strPathName & "(" & lngF & ")"
            lngF = lngF + 1
        Loop
        'Optionally re-add '\' to the end of the path
        If bSlash = True Then strPath = strPath & Chr(92)
        FolderNameUnique = strPath
    lbl_Exit:
        Exit Function
    End Function
    
    Private Function FolderExists(fldr) As Boolean
    'An Office macro by Graham Mayor - www.gmayor.com
    Dim FSO As Object
        Set FSO = CreateObject("Scripting.FileSystemObject")
        If (FSO.FolderExists(fldr)) Then
            FolderExists = True
        Else
            FolderExists = False
        End If
    lbl_Exit:
        Exit Function
    End Function
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Hi Graham.

    A Huge thank you.
    I haven't tested anything yet but to answer some of your thoughts:

    there will only be one type of attachment and only the same password.
    i just created a rule saying from this sender, while having attachment .
    basically the sender & attachment is the same and rule will only apply to that specific rule set.

    only thing I wish is that it wasn't client side:-/
    i look forward to testing your code on Monday!

  4. #4
    You will probably have to sign the project client side - http://www.gmayor.com/create_and_emp...gital_cert.htm

    Having the same password each time makes things easier, but be aware that there can be images (e.g. from a signature) in the attachment collection, so you will need to loop through the attachments to ensure you process only the Zip or things will get 'interesting'.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    While transcribing the code and describing the process for my web site - http://www.gmayor.com/extract_files_...ttachments.htm
    I discovered that the command line processor would create the files whether or not there was a password, but where the password was incorrect or missing the files were of zero bytes length, and thus useless and in the way of correct extraction.

    I used this to allow the files to be extracted correctly with no password, a default password or a prompted password, with any invalid zero byte files removed. The updated code is on my web site at the above link.
    Last edited by gmayor; 03-20-2016 at 03:28 AM.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  6. #6
    Hi Graham

    So I've been trying to get your code to work..

    here's my progress so far..

    I downloaded the .bas file from your site.
    I imported it into outlook VBA
    I changed the relevant parts in the code.. and I deleted the "unzip without password" part.. I assume I needed to keep the one I want to use and remove the other..
    But.. looking at the code it appeard that the "unzip without password" does the same as the one with password.. at least it has the -p parameter as well..

    As far as I can read you also remembered to NOT add space between -p & the password (-pMySecretPass)

    I created a new rule and applied the script.. but nothing happened...

    I don't get any popup messages or anything else.. When I select "run rule now" from outlook it does run.. but nothing happens ... not msgbox or anything else...

    I enabled ALL macros at this stage but that doesn't seem to help either... it doesn't even create the folders..

    any thougts?

    unzip1.jpgunzip2.jpg

  7. #7
    hm... disabling Macros and THEN restarting outlook helped... it 'werks!!

  8. #8
    I signed the vba project...
    So now I need to export it and give it to the user that needs it..
    any way to avoid having to accept the warning about macros?
    I used a domain code signing certificate (stored in my personal cert. store) to sign it...

  9. #9
    Hm.. the script started prompting with an error on this line:

    RmDir strPath

    It was extracting some zip files that wan't "part of the plan" since I hadn't narrowed down my rule yet.. I cannot recreate it though :-|

  10. #10
    damnit.. I need to point the save folder to an UNC path.
    The script doesn't seem to like that.. at all.. :-|

    Private Function CreateFolders(strPath As String)
    'An Office macro by Graham Mayor - www.gmayor.com
    Dim strTempPath As String
    Dim lngPath As Long
    Dim vPath As Variant
        vPath = Split(strPath, "\")
        strPath = vPath(0) & "\"
        For lngPath = 1 To UBound(vPath)
            strPath = strPath & vPath(lngPath) & "\"
            If Not FolderExists(strPath) Then MkDir strPath
        Next lngPath
    lbl_Exit:
        Exit Function
    End Function

  11. #11
    I have not worked with any of the processes and UNC paths. It should work if the networked folder is mapped to a Windows drive letter.

    It was not necessary, nor desirable, to remove sections of code relating to passwords as this was part of the error trapping. You can enter your common password at the start of the sub in the updated version from my web site in the line
    Const sDefaultPassword As String = "#test#" 'Change as                      required
    Use the test macro to test the process. If that works, then provided your rule identifies the messages correctly it will only process those messages on arrival.

    You can remove the alternative Private Sub UnZipFile(vFname As Variant) as this is just included for completeness and is not required by the process.

    Unless the user has a valid certificate correctly installed and used to sign the project it will not work correctly. My web page has instructions.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  12. #12
    Hi Graham.
    Thx, yes if I have a mapped network drive it does work. I would just very much prefer to point directly to shared folder so I don't need to mount a network drive for this single purpose.
    So using UNC's isn't as easy as that?

  13. #13
    Replace the CreateFolders process with the following which will write to UNC file paths:
    Private Sub CreateFolders(strPath As String)
    Dim lngPathSep As Long
    Dim lngPS As Long
        If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
        lngPathSep = InStr(3, strPath, "\")
        If lngPathSep = 0 Then GoTo lbl_Exit
        Do
            lngPS = lngPathSep
            lngPathSep = InStr(lngPS + 1, strPath, "\")
            If lngPathSep = 0 Then Exit Do
            If Len(Dir(Left(strPath, lngPathSep), vbDirectory)) = 0 Then Exit Do
        Loop
        Do Until lngPathSep = 0
            MkDir Left(strPath, lngPathSep)
            lngPS = lngPathSep
            lngPathSep = InStr(lngPS + 1, strPath, "\")
        Loop
    lbl_Exit:
        Exit Sub
    End Sub
    Last edited by gmayor; 03-22-2016 at 02:21 AM.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  14. #14
    OMG... it does exactly what I want...

    Now to test some more before taking it Live..

    Graham this is fantastic!! it'll save quite a lot of clicks moving forward.. thank you so much!!

    last step will be to replace my code with your updated code and add the network snippet to the 'new' code...

    Graham you've been tremendously helpful!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •