M
Mark Stephens
Hi all,
I found a tremendous chunk of code (see below) at :
http://www.outlookcode.com/codedetail.aspx?id=1333
It works a treat except for one thing, it creates the email but does not
send it (I am using Outlook 2007); it puts it in the drafts folder and you
then have to send it manually. I have had a go at debugging it and it seems
that the line:
Set itm = Application.Session.GetItemFromID(ID)
(near the end) is failing as when I break before the next line (itm.Send)
itm is empty (i.e. the code returned nothing).
Does anyone have any idea how I can fix this so the email just sends
automatically rather than being placed in the drafts folder and/or how to
fix the line that isn't working if they are not one and the same problem
(which I suspect they are).
Thanks and regards, Mark
_____________________________________________________________________
Sub SendDocAsMsg()
Dim wd As Word.Application
Dim doc As Word.Document
Dim itm As Object
Dim ID As String
Dim blnWeOpenedWord As Boolean
Dim sSubject As String
Dim sEmailAddress As String
On Error Resume Next
sSubject = "Follow up"
sEmailAddress = "(e-mail address removed)"
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
blnWeOpenedWord = True
End If
Set doc = wd.Documents.Open(Filename:="C:\WRWRInfo1.docx",
ReadOnly:=True)
Set itm = doc.MailEnvelope.Item
With itm
.from = sEmailAddress
.To = sEmailAddress
.CC = sEmailAddress
.Subject = sSubject
.Save
ID = .EntryID
End With
Set itm = Nothing
Set itm = Application.Session.GetItemFromID(ID)
itm.Send
doc.Close wdDoNotSaveChanges
If blnWeOpenedWord Then
wd.Quit
End If
Set doc = Nothing
Set itm = Nothing
Set wd = Nothing
End Sub
I found a tremendous chunk of code (see below) at :
http://www.outlookcode.com/codedetail.aspx?id=1333
It works a treat except for one thing, it creates the email but does not
send it (I am using Outlook 2007); it puts it in the drafts folder and you
then have to send it manually. I have had a go at debugging it and it seems
that the line:
Set itm = Application.Session.GetItemFromID(ID)
(near the end) is failing as when I break before the next line (itm.Send)
itm is empty (i.e. the code returned nothing).
Does anyone have any idea how I can fix this so the email just sends
automatically rather than being placed in the drafts folder and/or how to
fix the line that isn't working if they are not one and the same problem
(which I suspect they are).
Thanks and regards, Mark
_____________________________________________________________________
Sub SendDocAsMsg()
Dim wd As Word.Application
Dim doc As Word.Document
Dim itm As Object
Dim ID As String
Dim blnWeOpenedWord As Boolean
Dim sSubject As String
Dim sEmailAddress As String
On Error Resume Next
sSubject = "Follow up"
sEmailAddress = "(e-mail address removed)"
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
blnWeOpenedWord = True
End If
Set doc = wd.Documents.Open(Filename:="C:\WRWRInfo1.docx",
ReadOnly:=True)
Set itm = doc.MailEnvelope.Item
With itm
.from = sEmailAddress
.To = sEmailAddress
.CC = sEmailAddress
.Subject = sSubject
.Save
ID = .EntryID
End With
Set itm = Nothing
Set itm = Application.Session.GetItemFromID(ID)
itm.Send
doc.Close wdDoNotSaveChanges
If blnWeOpenedWord Then
wd.Quit
End If
Set doc = Nothing
Set itm = Nothing
Set wd = Nothing
End Sub