Hi
I am new to these forums, so apologise if my thread is not the easiest to understand.
I have some VBA code in Outlook which is currently saving any Excel attachments it finds in a sub-folder to a specific drive.
Once these attachments are saved, I then need to delete them or move them to the trash.
It then goes on to open an Excel spreadsheet.
Is this possible to delete the emails? Below is the code I have so far, could someone please indicate where the code to delete the mails should go?
Thanks very much in advance!
Sub GetEmailAttachment()
On Error GoTo GetAttachments_err
'Set variables
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("CFD 59065")
i = 0
'searches inbox for attachments
If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If
'Saves email attachments
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
If Right(Atmt.FileName, 3) = "xls" Then
FileName = "N:\Investment\Performance Measurement\PERFMEAS - NUIM\EQUITY\CFD\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
Next Item
'results
If i > 0 Then
varResponse = MsgBox("I found " & i & " attached files." _
& vbCrLf & "I have saved them into the CFD folder." _
& vbCrLf & vbCrLf & "Press Yes to run the CFD master macro now, press no to run it later" _
, vbQuestion + vbYesNo, "Finished!")
If varResponse = vbYes Then
Shell "Explorer.exe /e,N:\Investment\Performance Measurement\PERFMEAS - NUIM\EQUITY\CFD\cfd master pierre.xls", vbNormalFocus
End If
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
"Finished!"
End If
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
'error
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
Exit Sub
End Sub
I am new to these forums, so apologise if my thread is not the easiest to understand.
I have some VBA code in Outlook which is currently saving any Excel attachments it finds in a sub-folder to a specific drive.
Once these attachments are saved, I then need to delete them or move them to the trash.
It then goes on to open an Excel spreadsheet.
Is this possible to delete the emails? Below is the code I have so far, could someone please indicate where the code to delete the mails should go?
Thanks very much in advance!
Sub GetEmailAttachment()
On Error GoTo GetAttachments_err
'Set variables
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("CFD 59065")
i = 0
'searches inbox for attachments
If SubFolder.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If
'Saves email attachments
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
If Right(Atmt.FileName, 3) = "xls" Then
FileName = "N:\Investment\Performance Measurement\PERFMEAS - NUIM\EQUITY\CFD\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
Next Atmt
Next Item
'results
If i > 0 Then
varResponse = MsgBox("I found " & i & " attached files." _
& vbCrLf & "I have saved them into the CFD folder." _
& vbCrLf & vbCrLf & "Press Yes to run the CFD master macro now, press no to run it later" _
, vbQuestion + vbYesNo, "Finished!")
If varResponse = vbYes Then
Shell "Explorer.exe /e,N:\Investment\Performance Measurement\PERFMEAS - NUIM\EQUITY\CFD\cfd master pierre.xls", vbNormalFocus
End If
Else
MsgBox "I didn't find any attached files in your mail.", vbInformation, _
"Finished!"
End If
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
'error
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
Exit Sub
End Sub