[Outlook 2003 VBA] Help to save two attached files in different paths with VBA

Not open for further replies.


Hi everybody!

Some month ago I started to program Outlook VBA. Currently I am facing one issue I am not been able to find the solution by myself:

I am trying to save two files (attached in the same e-mail)to different disk drive paths. In addition of this issue, what makes this issue complicated is that files has only the mid part of their name always with the same label, changing the beginning and the end of the FileName.

I developed the code pasted below, but the problem is the Index of attachments: files could be saved in the wrong folder, according their attachment index in the e-mail.

Do you have any suggestions to save the file "A" always in the folder "A", and the file "B" always in the folder "B"?

Here you are the code:

Private WithEvents Items As Outlook.Items
Option Explicit

Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Dim X As Integer
Set objNS = GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
Application.ActiveExplorer.WindowState = olMaximized
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")

If TypeOf item Is Outlook.MailItem Then
 Dim Msg8 As Outlook.MailItem
 Set Msg8 = item

If (Msg8.SenderName = "sendername") And (Msg8.Attachments.Count > 0) Then
   Dim olDestFldr8 As Outlook.MAPIFolder
   Dim myAttachments8 As Outlook.Attachments
   Dim Att8 As String

   Const attPath8 As String = "Path"

   Set olDestFldr8 = objNS.Folders("Archivio 2010").Folders("Posta in arrivo")

   ' save attachment
   Set myAttachments8 = item.Attachments

   Dim u As Integer

   For u = 1 To myAttachments8.Count

   Att8 = myAttachments8.item(u).DisplayName

   On Error Resume Next
   myAttachments8.item(u).SaveAsFile attPath8 & Att8

   If Mid(Msg8.Attachments.FileName, 7, 9) = "CC+GENIAL" Then
       Kill (attPath8 & Att8)

       Dim Att81 As String
       Att81 = myAttachments8.item(1).DisplayName

       Const attPath81 As String = "Path\A\"

       myAttachments8.item(1).SaveAsFile attPath81 & Att81 
   End If

   If Mid(Msg8.Attachments.FileName, 7, 9) = "Giornalie" Then
       Kill (attPath8 & Att8)

       Dim Att82 As String
       Att82 = myAttachments8.item(2).DisplayName

       Const attPath82 As String = "Path\B\"
       myAttachments8.item(2).SaveAsFile attPath82 & Att82
   End If

   Next u

  Msg8.UnRead = False
   Msg8.Move olDestFldr8
 End If
End If
End Sub

Thanks in advance for any help!
Not open for further replies.
Thread starter Similar threads Forum Replies Date
G Outlook 2003 VBA Won't Run In Outlook 2010 Outlook VBA and Custom Forms 4
J How to set a flag to follow up using VBA for outlook 2003 Using Outlook 10
P Outlook 2003 - Regra em VBA Outlook VBA and Custom Forms 1
P 'Trusted' VBA code in Outlook 2003? Outlook VBA and Custom Forms 2
M VBA Form how to load in Outlook 2003 Outlook VBA and Custom Forms 4
R Outlook 2003/2007 Rule and Conditions for InBox VBA customization Outlook VBA and Custom Forms 3
B Outlook 2003 email sending & receiving suddenly stopped working Using Outlook 3
H Outlook 2003 find by "has attachment" Using Outlook 1
glnz How set up new IMAP on Outlook-Office 365 and merge in pst from Outlook 2003 for same two email accounts? Using Outlook 5
P Import Categories from Outlook 2003 Using Outlook 8
V Outlook 2003 problem with Windows 10 Creators Update 1709 Using Outlook 0
M Outlook 2003 pictures - some visible, some not Using Outlook 0
S Outlook 2003 to Outlook 2013 pst file Using Outlook 5
O Memory Leak in Outlook 2003 Using Outlook 3
W Changing looks of emails in Outlook 2003 Using Outlook 0
O Outlook 2003 can't send, but settings seem OK Using Outlook 1
P URL Hyperlink not working correctly in Outlook 2003 Using Outlook 10
O Outlook 2003 can't open contacts. Using Outlook 2
O Promoting Outlook 2003 User Templates Using Outlook 1
O W-a-a-y too many PSTs (Outlook 2003) Using Outlook 0
J Outlook 2003-2010 PST Field Editor Using Outlook 1
P Outlook 2003 - Do I need a new profile? Using Outlook 2
E Want to Import Outlook 2003 pst files to later version Using Outlook 6
A error message outlook 2003 Using Outlook 1
B Seeking advice now Outlook 2003 is unsupported by Exchange Using Outlook 4
O Change Debit to Credit in Outlook 2003? Using Outlook 1
J problems downloading POP3 emails to Outlook 2003 Using Outlook 1
P Outlook 2003 - possible to recreate corrupt account? Using Outlook 3
Calvyn Outlook 2003 cannot import .vcs subject Using Outlook 1
T Query about one aspect of migrating .pst files from Outlook 2003 to Outlook 2013 Using Outlook 5
C Outlook 2003 contacts Using Outlook 1
G Configuring Outlook 2003 for Gmail with both pop3 & imap4 accounts Using Outlook 1
M HELP--Extract Data from 2003 outlook transfer to excel spreadsheet Using Outlook 1
V Outlook 2003 editing problem Using Outlook 4
X Outlook 2003 not sending all of the new email message Using Outlook 1
2 How to use outlook 2003 calendar in always offline mode Using Outlook 0
G Outlook 2003 I need to move email to folder based on subject, using wild card Using Outlook 0
G outlook 2013 - Open In Outlook 2003 Using Outlook 1
A Exchange 2003 Outlook 2010 64 Bit- AutoDiscover Connection Err - Certificate Exchange Server Administration 9
T Use Outlook 2003 with Office 2013 Using Outlook 1
D Outlook 2003 contact folder opend in scrolled down position Using Outlook 2
O Need advice ASAP! Outlook 2003. Using Outlook 1
H Custom Contact form not working in Outlook 2003 Using Outlook 3
O Outlook 2003 forms problem Using Outlook 3
O Duplicate folders in Outlook 2003 Using Outlook 3
O Moving OUtlook 2003 from bad XP to Win 7 Pro 64 -- URGENT! Using Outlook 8
A File - Save Attachments does nothing in Outlook 2003 with Exchange 2010 ... Using Outlook 3
R Menus in a new\old email not there in Outlook 2003 Using Outlook 2
R OUTLOOK 2003 on WinXP, Prob: CONTACTS or ADDRESS BOOK not connected or missing Using Outlook 6
R Outlook 2003 not working Using Outlook 13
Similar threads