Transfer Excel VBA Generated emails to a folder in outlook

[QMAN223]

Hi,

I have a requirement where I need to transfer the emails my Macro creates to a Draft folder in Outlook.

Is this possible?

Here is the Macro code that I use to generate the emails...

Sub jec()
 For Each sh In ThisWorkbook.Sheets
   With CreateObject("Outlook.Application").CreateItem(0)
    .To = Join(Application.Transpose(sh.ListObjects(1).DataBodyRange.Columns(1)), ";")
    .CC = Join(Application.Transpose(sh.ListObjects(1).DataBodyRange.Columns(2)), ";")
    .Subject = "Training Report  - " & Format(DateAdd("d", 1 - Weekday(Now), Now), "dd-MM-yyyy")
    .Body = "Dear All" & vbCrLf & vbCrLf & "Please find attached the Weekly Training report." & vbCrLf & vbCrLf & "Kind Regards,"
    '.Attachments.Add
    .display '.send
   End With
 Next
End Sub

 

[JEC]

Hi familiar code

Change .display to .Save
That will probably do the trick for you

 

[6StringJazzer]

Change .display to .Save

You can use both.

 

[JEC]

But why display first when saving at once is possible?

 

[6StringJazzer]

Depends on what the user wants to do. I'm just pointing out that you are not limited to use one or the other.

 

[JEC]

Ahh yeah ofcourse, lets see

 

[QMAN223]

Hi familiar code

Change .display to .Save
That will probably do the trick for you

AHAHAHA, I was going to message you before but I rather make it a new Post to help someone else out if they wanted to do something similar.

 

[QMAN223]

Hi familiar code

Change .display to .Save
That will probably do the trick for you

Code works like a charm! Thanks JEC! What if I wanted to save emails to a particular folder in Outlook?

 

[JEC]

Yes, this code moves the just saved draft mail to a subfolder of the inboxmail, in this case the folder "test".
The 6 in .GetDefaultfolder(6) means your normal inbox folder.

Sub jec()
 For Each sh In ThisWorkbook.Sheets
   Set olApp = CreateObject("outlook.application")
   With olApp.CreateItem(0)
    .To = Join(Application.Transpose(sh.ListObjects(1).DataBodyRange.Columns(1)), ";")
    .CC = Join(Application.Transpose(sh.ListObjects(1).DataBodyRange.Columns(2)), ";")
    .Subject = "Training Report  - " & Format(DateAdd("d", 1 - Weekday(Now), Now), "dd-MM-yyyy")
    .Body = "Dear All" & vbCrLf & vbCrLf & "Please find attached the Weekly Training report." & vbCrLf & vbCrLf & "Kind Regards,"
    .Save
    .Move olApp.GetNamespace("MAPI").Getdefaultfolder(6).Folders("test")
   End With
 Next
End Sub

 

[QMAN223]

Yes, this code moves the just saved draft mail to a subfolder of the inboxmail, in this case the folder "test".
The 6 in .GetDefaultfolder(6) means your normal inbox folder.

Sub jec()
 For Each sh In ThisWorkbook.Sheets
   Set olApp = CreateObject("outlook.application")
   With olApp.CreateItem(0)
    .To = Join(Application.Transpose(sh.ListObjects(1).DataBodyRange.Columns(1)), ";")
    .CC = Join(Application.Transpose(sh.ListObjects(1).DataBodyRange.Columns(2)), ";")
    .Subject = "Training Report  - " & Format(DateAdd("d", 1 - Weekday(Now), Now), "dd-MM-yyyy")
    .Body = "Dear All" & vbCrLf & vbCrLf & "Please find attached the Weekly Training report." & vbCrLf & vbCrLf & "Kind Regards,"
    .Save
    .Move olApp.GetNamespace("MAPI").Getdefaultfolder(6).Folders("test")
   End With
 Next
End Sub

Oh I see. Cheers!

Is the '.GetNamespace("MAPI")' necessary for the code? What does that do?