- Joined
- May 24, 2016
- Messages
- 1
- Reaction score
- 0
My below query helps me to unzip the file and save file from email to a folder. however I have 2 modifications to be made:
1) the email folder right now is a sub folder within inbox, however the mail box link is to my pst sub folder. How do i add the same? ex: Inbox: FY2016:ABC
2)if the file attchment is a zip file it works well, however if it is a csv.zip file the below code does not work. why?
Sub Unzip(MyMail As MailItem)
Dim Ns As NameSpace 'variables for the main functionality
Dim Inbox As MAPIFolder
Dim subfolder As MAPIFolder
Dim Atchmt As Attachment
Dim FileName As Variant
Dim msg As outlook.MailItem
Dim FSO As Object 'variables for unzipping
Dim oApp As Object
Dim FileNameFolder As Variant
Set Ns = GetNamespace("MAPI")
Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
Set subfolder = Inbox.Folders("Aribatest")
For Each msg In subfolder.Items
For Each Atchmt In msg.Attachments
If (Right(Atchmt.FileName, 3) = "zip") Then
FileNameFolder = "T:\FPA\Test\"
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(Atchmt.FileName).Items
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
Next
Next
End Sub
1) the email folder right now is a sub folder within inbox, however the mail box link is to my pst sub folder. How do i add the same? ex: Inbox: FY2016:ABC
2)if the file attchment is a zip file it works well, however if it is a csv.zip file the below code does not work. why?
Sub Unzip(MyMail As MailItem)
Dim Ns As NameSpace 'variables for the main functionality
Dim Inbox As MAPIFolder
Dim subfolder As MAPIFolder
Dim Atchmt As Attachment
Dim FileName As Variant
Dim msg As outlook.MailItem
Dim FSO As Object 'variables for unzipping
Dim oApp As Object
Dim FileNameFolder As Variant
Set Ns = GetNamespace("MAPI")
Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
Set subfolder = Inbox.Folders("Aribatest")
For Each msg In subfolder.Items
For Each Atchmt In msg.Attachments
If (Right(Atchmt.FileName, 3) = "zip") Then
FileNameFolder = "T:\FPA\Test\"
Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(Atchmt.FileName).Items
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
Next
Next
End Sub