Outlook VBA to save attachment from a mail,and then copy the attachment data in another excel and send the send excel via mail

Question

I am trying to create a Outlook VBA code to save attachments from a particular mail to a folder,then copy paste the data from the attachment in another excel.And then mail the 2nd excel to some ids.

I have created a rule 1st to move the incoming auto mail to a particular mail folder,Then save its attachment to the desktop folder.After saving the attachment the data gets copied to the 2nd excel. The code is like this

Public Sub ExportFile(MyMail As MailItem)
 Dim outNS As Outlook.NameSpace
 Dim outFolder As Outlook.MAPIFolder
 Dim outNewMail As Outlook.MailItem
 Dim strDir As String
  Set outNS = GetNamespace("MAPI")
  Set outFolder = outNS.GetDefaultFolder(olFolderInbox).Folders("Network Critical Report")
  Set outNewMail = outFolder.Items.GetLast
  strDir = "C:\Users\soumyajitd\Desktop\December\Network Critical Report\"
  If outNewMail.Attachments.count = 0 Then GoTo Err
  outNewMail.Attachments(1).SaveAsFile strDir & "Network_Critical_Report.csv"
Dim xlApp As Excel.Application
Dim wbTarget As Excel.Workbook 'workbook where the data is to be pasted
Dim wsTarget As Excel.Worksheet
Dim wbThis As Excel.Workbook 'workbook from where the data is to copied
Dim wsThis As Excel.Worksheet
Dim strName  As String   'name of the source sheet/ target workbook
 Set xlApp = New Excel.Application
 xlApp.DisplayAlerts = False
 'xlApp.Workbooks.Open strDir & "Network_Critical_Report.csv"
 'xlApp.Workbooks.Open strDir & "Test.xlsx"
 Set wbThis = xlApp.Workbooks.Open("C:\Users\soumyajitd\Desktop\December\Network   Critical Report\Network_Critical_Report.csv")
 Set wsThis = wbThis.Worksheets("Network_Critical_Report")
 Set wbTarget = xlApp.Workbooks.Open("C:\Users\soumyajitd\Desktop\December\Network Critical Report\Test.xlsx")
 Set wsTarget = wbTarget.Worksheets("Raw_Data")
 'select cell A1 on the target book
 'clear existing values form target book
 wsTarget.UsedRange.ClearContents
 'activate the source book
 wbThis.Activate
 xlApp.CutCopyMode = False
 'copy the range from source book
 wsThis.UsedRange.Copy
 'paste the data on the target book
 wsTarget.Range("A1").PasteSpecial Paste:=xlPasteValues
 'save the target book
 wbTarget.Save
 'close the workbook
 wbTarget.Close
 wbThis.Close
 xlApp.CutCopyMode = False
 Kill ("C:\Users\soumyajitd\Desktop\December\Network Critical Report\Network_Critical_Report.csv")
 'clear memory
 Set wbTarget = Nothing
 Set wbThis = Nothing
 Set xlApp = Nothing
 Set outNewMail = Nothing
 Set outFolder = Nothing
 Set outNS = Nothing
Err:
 Set outFolder = Nothing
 Set OuNewMail = Nothing
 Set outNS = Nothing
End Sub

The second code is to send a new email with "Test.xlsx" as attachment.It is like this :

Sub SendNew(Item As Outlook.MailItem)

 Dim objMsg As MailItem
 Dim ToRecipient As Variant
 Dim ccRecipient As Variant
 Dim Subject As String
 Dim Body As String
 Dim FilePathtoAdd As String
 Set objMsg = Application.CreateItem(olMailItem)



 objMsg.ToRecipients.Add "alias@mail.com"
 objMsg.CCRecipients.Add "xx@yy.com"
 objMsg.Subject = "Subject"
 objMsg.Body = "Body"

 If FilePathtoAdd <> "" Then
 objMsg.Attachments.Add "C:\Users\soumyajitd\Desktop\December\Network Critical Report\Test.xlsx"
 End If

objMsg.Send

I have very little experience in VBA coding.I have taken all these codes from different forums and have modified them to suit my need.

Now there are 3 problems.

The attachment which is getting saved is not from the last mail,it is taking the data from the 2nd last mail.
I am trying to run the script by adding rule for receiving mail,but it is showing only the 2 different scripts. I tried many ways but couldnot combine both of them.
The 2nd script is not working,giving an error "Runtime error '-2147467259(8004005)': "Outlook doesnot recongnize 1 or more names"

Do you think [THIS](http://stackoverflow.com/questions/11781320/download-attachment-from-outlook-and-open-in-excel/11782153#11782153) is of any help to you? — Siddharth Rout, Dec 12 '13 at 11:35
It will solve the 1st problem,but sending out the new mail option and also the issue of linking the scripts remain.Basically the moment I create a new "Sub" a new script is created.How do I keep all this small codes in 1 program — Soumyajit, Dec 12 '13 at 11:55
There is no property called `ToRecipients`, `CCRecipients`. Change it to `objMsg.To = "alias@mail.com"` and `objMsg.CC = "xx@yy.com"` — Siddharth Rout, Dec 12 '13 at 12:05
That is because `FilePathtoAdd = ""` and hence the If Condition is not met. — Siddharth Rout, Dec 12 '13 at 12:32
Changed it to objMsg.Attachments.Add "C:\Users\soumyajitd\Desktop\December\Network Critical Report\Test.xlsx" — Soumyajit, Dec 12 '13 at 12:40
That is what I said :) see my answer below. You may have to refresh the page. — Siddharth Rout, Dec 12 '13 at 12:41

score 2 · Accepted Answer · edited May 23 '17 at 12:21

For your 1st Problem, see THIS

For your 2nd Problem

To combine, either join both the scripts in one SUB or call the other from the first.

For your 3rd Problem

There is no property called .ToRecipients and .CCRecipients. Change it to objMsg.To = "alias@mail.com" and objMsg.CC = "xx@yy.com" respectively.

Also your FilePathtoAdd = "" so your if condition is not met. Either delete that IF Condition or change your code to this

FilePathtoAdd = "C:\Users\soumyajitd\Desktop\December\Network Critical Report\Test.xlsx"

With objMsg
    .To = "alias@mail.com"
    .CC = "xx@yy.com"
    .Subject = "Subject"
    .Body = "Body"
    .Attachments.Add FilePathtoAdd
End With

Outlook VBA to save attachment from a mail,and then copy the attachment data in another excel and send the send excel via mail

1 Answers1