1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Solved: Outlook VBA - unzip issue

Discussion in 'Business Applications' started by ange0223, Jan 17, 2013.

Thread Status:
Not open for further replies.
  1. ange0223

    ange0223 Thread Starter

    Joined:
    Jan 17, 2013
    Messages:
    2
    Hi -

    I created a Macro to print my outlook attachments even if they are zipped. The way that I am unzipping the file now involves me saving the zipped file to a temporary location and than unzipping from there.

    The problem is that when it saves the zipped file I automatically get a alert from exporerer asking if I want to unzip the file.

    How do I prevent this pop up from coming up or how do I automatically choose "No" using VBA. (DisplayAlerts = False does not work)

    Sub PrintMail()
    Dim ns As NameSpace
    Dim Item As Outlook.MailItem
    Dim Inbox As MAPIFolder
    Dim Atmt As Attachment
    Dim FileName As String
    Dim Done As MAPIFolder
    Dim i As Integer
    Dim Fname1 As String
    Dim myMailBox As String
    Dim currentTime As Date
    Dim unzipedFile As String
    Dim atmtName As String
    Dim searchString As String


    Dim oApp As Object
    Dim FileNameFolder As Variant
    Dim FSO As Object


    Set ns = GetNamespace("MAPI")
    myMailBox = "Mailbox - AD"
    searchString = ".zip"

    Select Case ns.GetDefaultFolder(olFolderInbox).Parent
    Case myMailBox
    Set MyInbox = ns.Folders(myMailBox).Folders("Inbox").Items
    Set PrintMailBox = ns.Folders("Mailbox - PRINT").Folders("Inbox").Items
    Set Inbox = ns.Folders("Mailbox - PRINT").Folders("Inbox")
    Set Done = Inbox.Folders("Printed")
    Case "Mailbox - PRINT"
    Set PrintMailBox = ns.Folders("Mailbox - PRINT").Folders("Inbox").Items
    Set Inbox = ns.Folders("Mailbox - PRINT").Folders("Inbox")
    Set Done = Inbox.Folders("Printed")
    End Select


    If PrintMailBox.Count > 0 Then
    For Each Item In PrintMailBox

    If Item.Attachments.Count > 0 Then

    Item.PrintOut

    For Each Atmt In Item.Attachments

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

    FileNameFolder = "C:\Temp\"
    FileName = FileNameFolder & Atmt.FileName
    Atmt.SaveAsFile FileName 'THIS IS WHERE THE POP UP OCCURS


    Set oApp = CreateObject("Shell.Application")
    oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((FileName)).Items

    On Error Resume Next
    Set FSO = CreateObject("scripting.filesystemobject")
    FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True

    Kill FileName

    atmtName = Atmt.FileName
    unzipedFile = Left(atmtName, (InStr(1, atmtName, searchString) - 1))

    Select Case Right(unzipedFile, 3)

    Case "doc"
    FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-doc") - 1))
    FileName = "C:\Temp\" & FileName & ".doc"
    ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

    Case "ocx"
    FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-docx") - 1))
    FileName = "C:\Temp\" & FileName & ".docx"
    ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

    Case "xls"
    FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-xls") - 1))
    FileName = "C:\Temp\" & FileName & ".xls"
    ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

    Case "lxs"
    FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-xlsx") - 1))
    FileName = "C:\Temp\" & FileName & ".xlsx"
    ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

    Case "ppt"
    FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-ppt") - 1))
    FileName = "C:\Temp\" & FileName & ".ppt"
    ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

    Case "pps"
    FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-pps") - 1))
    FileName = "C:\Temp\" & FileName & ".pps"
    ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

    Case "ptx"
    FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-pptx") - 1))
    FileName = "C:\Temp\" & FileName & ".pptx"
    ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

    Case "pdf"
    FileName = Left(unzipedFile, (InStr(1, unzipedFile, "-pdf") - 1))
    FileName = "C:\Temp\" & FileName & ".pdf"
    ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

    End Select


    Else

    FileName = "C:\Temp\" & Atmt.FileName
    Atmt.SaveAsFile FileName
    ShellExecute 0, "print", FileName, vbNullString, vbNullString, 0

    End If


    Next Atmt

    Item.Move Done

    End If

    Next Item
    End If


    currentTime = Now
    Do Until currentTime + TimeValue("00:00:30") <= Now
    Loop

    Call DeleteFiles

    End Sub
     
  2. 20_2_Many

    20_2_Many

    Joined:
    Jun 29, 2012
    Messages:
    518
    the only thing I see that might be a a problem and I do not see why, but, the dim statement,
    might need to be
    Dim Atmt As Outlook.Attachment
    all the code I have searched, that is really the only difference I have found. Hope it is this easy! Good Luck!
     
  3. ange0223

    ange0223 Thread Starter

    Joined:
    Jan 17, 2013
    Messages:
    2
    alright, I think I found the answer. I save the zip file as a text file and then rename it to unzip:

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

    FileNameFolder = "C:\Temp\"
    FileName = FileNameFolder & Left(Atmt.FileName, (InStr(1, Atmt.FileName, ".zip") - 1)) & ".txt"
    Atmt.SaveAsFile FileName 'copy the file to the folder

    FileNameT = FileNameFolder & Atmt.FileName

    Name FileName As FileNameT

    Set oApp = CreateObject("Shell.Application")
    oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((FileNameT)).Items
     
As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1085694

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice