View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
keepITcool keepITcool is offline
external usenet poster
 
Posts: 2,253
Default Deferred Mailing from Outlook



Don Lloyd wrote :

Hi,

After doing enough research to warrant an automatic award of a Ph.D
or two, I have come up with the following gem.
Unfortunately, it doesn't work as it should!

The problem is as follows:
If the routine is run when Outlook is open, it works as intended and
the e-mail goes to the Drafts Folder.
However, if Oulook in NOT open when the routine is run, when it is
subsequently opened, the e-mail appears in the Inbox, which is not
acceptable.

Any ideas ?

TIA
regards'

Don



Well well... give some credit to those who help you!

Ph.D?
Extensive research??

sounds to me you just used the snippet i gave you earlier.
though admittedly it was late :)




Here's the improved version

Note the subtle differences between the Early- and Late-bound
alternatives..



Sub DeferredMail_Short()
Dim Fname, Sbjct

ActiveSheet.Copy
Fname = "C:\MailTemp\" & "TempMail.xls"
If Dir(Fname) < "" Then Kill Fname
ActiveWorkbook.SaveAs Fname
ActiveWorkbook.Close False
Sbjct = "Just Testing Short"

With CreateObject("Outlook.Application")

With .CreateItem(0) 'olMailItem
.To = "
.Subject = Sbjct
.Body = "Notes:"
.Attachments.Add Fname
.Save
.Move .Parent.Session.GetDefaultFolder(16) 'olFolderDrafts
End With
End With
Kill Fname

End Sub

Sub DeferredMail_Long()
Dim Fname, Sbjct
Dim olApp As Outlook.Application
Dim olFld As Outlook.MAPIFolder
Dim olMsg As Outlook.MailItem


ActiveSheet.Copy
Fname = "C:\MailTemp\" & "TempMail.xls"
If Dir(Fname) < "" Then Kill Fname
ActiveWorkbook.SaveAs Fname
ActiveWorkbook.Close False
Sbjct = "Just Testing Long"
Set olApp = New Outlook.Application
Set olFld = olApp.Session.GetDefaultFolder(olFolderDrafts)
Set olMsg = olApp.CreateItem(olMailItem)

With olMsg
.To = "
.Subject = Sbjct
.Body = "Notes:"
.Attachments.Add Fname
.Save
End With
Kill Fname

Set olMsg = Nothing
Set olFld = Nothing
Set olApp = Nothing
End Sub



--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam