Solved: Outlook VBA - unzip issue

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

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
 
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!
 

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
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

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 807,865 other people just like you!

Latest posts

Members online

Top