G
geebee
hi,
i would like to amend the following so that no attachment is included...
just not sure how
Sub HTMLtest()
'*****************************************YES
' Outlook objects
Dim objApp As Outlook.Application
Dim l_Msg As MailItem
Dim colAttach As Outlook.Attachments
Dim l_Attach As Outlook.Attachment
Dim oSession As Object 'MAPI.Session
' CDO objects
Dim oMsg As Object 'MAPI.Message
Dim oAttachs As Object 'MAPI.Attachments
Dim oAttach As Object 'MAPI.Attachment
Dim colFields As Object 'MAPI.Fields
Dim oField As Object 'MAPI.Field
Dim strEntryID As String
' create new Outlook MailItem
Set objApp = CreateObject("Outlook.Application")
Set l_Msg = objApp.CreateItem(olMailItem)
' add graphic as attachment to Outlook message
' change path to graphic as needed
Set colAttach = l_Msg.Attachments
Set l_Attach = colAttach.Add("C:\DD\test.gif")
l_Msg.Close olSave
strEntryID = l_Msg.EntryID
Set l_Msg = Nothing
' *** POSITION CRITICAL *** you must dereference the
' attachment objects before changing their properties
' via CDO
Set colAttach = Nothing
Set l_Attach = Nothing
' initialize CDO session
On Error Resume Next
Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False
' get the message created earlier
Set oMsg = oSession.GetMessage(strEntryID)
' set properties of the attached graphic that make
' it embedded and give it an ID for use in an <IMG> tag
Set oAttachs = oMsg.Attachments
Set oAttach = oAttachs.Item(1)
Set colFields = oAttach.Fields
'Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
Set oField = colFields.Add(&H3712001E, "myident")
oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
oMsg.Update
' get the Outlook MailItem again
Set l_Msg = objApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
' add HTML content -- the <IMG> tag
l_Msg.CC = "(e-mail address removed)"
Dim emailTITLE As String
Sheets("sheet1").Shapes("ttl").Select
emailTITLE = "report" & Selection.Characters.Text
l_Msg.Subject = emailTITLE
Dim BDY2 As String
BDY2 = "note of test."
Dim BDY3 As String
BDY3 = "How to login:"
Dim BDY4 As String
BDY4 = "this is a test."
Dim BDY5 As String
BDY5 = "retest:"
Dim BDY6 As String
BDY6 = "testing. "
Dim BDY7 As String
BDY7 = "test"
Dim BDY8 As String
BDY8 = "Summary"
Dim BDY9 As String
BDY9 = "test:"
Dim BDY10 As String
BDY10 = "test"
l_Msg.HTMLBody = "<html><p><font size=""1"" color=""336699"" face =
""arial"">" _
& emailTITLE & "</font><br>" _
& "<font size=""1"" color=""336699"" face = ""arial"">" _
& BDY2 & "</font>" _
& "</p>" _
& "<font size=""1"" color=""336699"" face = ""arial"">" _
& BDY3 & "</font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY4 & "</font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY5 & "</font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY6 & "</font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY7 & "</font>" _
& "<br><br><font size=""2"" color=""999999"" face = ""arial""><b>" _
& BDY8 & "</b></font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY9 & "</font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY10 & "</font><br><br>" _
& "<img src=""C:\DD\test.gif"">"
l_Msg.Close (olSave)
l_Msg.Display
' clean up objects
Set oField = Nothing
Set colFields = Nothing
Set oMsg = Nothing
oSession.Logoff
Set oSession = Nothing
Set objApp = Nothing
Set l_Msg = Nothing
End Sub
thanks in advance,
geebee
i would like to amend the following so that no attachment is included...
just not sure how
Sub HTMLtest()
'*****************************************YES
' Outlook objects
Dim objApp As Outlook.Application
Dim l_Msg As MailItem
Dim colAttach As Outlook.Attachments
Dim l_Attach As Outlook.Attachment
Dim oSession As Object 'MAPI.Session
' CDO objects
Dim oMsg As Object 'MAPI.Message
Dim oAttachs As Object 'MAPI.Attachments
Dim oAttach As Object 'MAPI.Attachment
Dim colFields As Object 'MAPI.Fields
Dim oField As Object 'MAPI.Field
Dim strEntryID As String
' create new Outlook MailItem
Set objApp = CreateObject("Outlook.Application")
Set l_Msg = objApp.CreateItem(olMailItem)
' add graphic as attachment to Outlook message
' change path to graphic as needed
Set colAttach = l_Msg.Attachments
Set l_Attach = colAttach.Add("C:\DD\test.gif")
l_Msg.Close olSave
strEntryID = l_Msg.EntryID
Set l_Msg = Nothing
' *** POSITION CRITICAL *** you must dereference the
' attachment objects before changing their properties
' via CDO
Set colAttach = Nothing
Set l_Attach = Nothing
' initialize CDO session
On Error Resume Next
Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False
' get the message created earlier
Set oMsg = oSession.GetMessage(strEntryID)
' set properties of the attached graphic that make
' it embedded and give it an ID for use in an <IMG> tag
Set oAttachs = oMsg.Attachments
Set oAttach = oAttachs.Item(1)
Set colFields = oAttach.Fields
'Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
Set oField = colFields.Add(&H3712001E, "myident")
oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True
oMsg.Update
' get the Outlook MailItem again
Set l_Msg = objApp.GetNamespace("MAPI").GetItemFromID(strEntryID)
' add HTML content -- the <IMG> tag
l_Msg.CC = "(e-mail address removed)"
Dim emailTITLE As String
Sheets("sheet1").Shapes("ttl").Select
emailTITLE = "report" & Selection.Characters.Text
l_Msg.Subject = emailTITLE
Dim BDY2 As String
BDY2 = "note of test."
Dim BDY3 As String
BDY3 = "How to login:"
Dim BDY4 As String
BDY4 = "this is a test."
Dim BDY5 As String
BDY5 = "retest:"
Dim BDY6 As String
BDY6 = "testing. "
Dim BDY7 As String
BDY7 = "test"
Dim BDY8 As String
BDY8 = "Summary"
Dim BDY9 As String
BDY9 = "test:"
Dim BDY10 As String
BDY10 = "test"
l_Msg.HTMLBody = "<html><p><font size=""1"" color=""336699"" face =
""arial"">" _
& emailTITLE & "</font><br>" _
& "<font size=""1"" color=""336699"" face = ""arial"">" _
& BDY2 & "</font>" _
& "</p>" _
& "<font size=""1"" color=""336699"" face = ""arial"">" _
& BDY3 & "</font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY4 & "</font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY5 & "</font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY6 & "</font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY7 & "</font>" _
& "<br><br><font size=""2"" color=""999999"" face = ""arial""><b>" _
& BDY8 & "</b></font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY9 & "</font>" _
& "<br><font size=""1"" color=""336699"" face = ""arial"">" _
& BDY10 & "</font><br><br>" _
& "<img src=""C:\DD\test.gif"">"
l_Msg.Close (olSave)
l_Msg.Display
' clean up objects
Set oField = Nothing
Set colFields = Nothing
Set oMsg = Nothing
oSession.Logoff
Set oSession = Nothing
Set objApp = Nothing
Set l_Msg = Nothing
End Sub
thanks in advance,
geebee