K
Keith
The code below (thanks again to those of you in this group!) is used from
within Excel VBA to create outlook emails to send with embedded images.
The problem I've run into is that the range of cells I'm pasting in happen
to be larger than 8.5 inches wide, so recipients who try to print the email
(without manually changing the print to landscape) get part of the image cut
off.
Is there a way to force an email message's default print setting to
landscape, or is that /only/ handled by the recipient's instance of Outlook?
Many thanks,
Keith
Function EmbeddedHTMLGraphicDemo(SendToName As String, SendFileCount As
Integer)
' 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 MAPI.Session
' CDO objects
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
Dim oAttach As MAPI.Attachment
Dim colFields As MAPI.Fields
Dim oField As 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
FName = "c:\" & SendToName
FExt = ".gif"
For n = 1 To SendFileCount
Set l_Attach = colAttach.Add(FName & CStr(n) & FExt)
Next
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
For n = 1 To SendFileCount
Set oAttach = oAttachs.Item(n)
Set colFields = oAttach.Fields
Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg") '??
Set oField = colFields.Add(&H3712001E, "myident" & CStr(n))
Next
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
HTMLString = ""
For n = 1 To SendFileCount
HTMLString = HTMLString & "<IMG align=baseline border=0 hspace=0
src=cid:myident" & _
CStr(n) & ">" & "<br> </br>" & "In your reply, please enter
updates for the record above here:" & _
"<br> </br> <br> </br>"
Next
l_Msg.HTMLBody = HTMLString
l_Msg.To = SendToName
l_Msg.Subject = "Next Actions - please respond by 9am Thursday this week -
THANKS"
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 Function
within Excel VBA to create outlook emails to send with embedded images.
The problem I've run into is that the range of cells I'm pasting in happen
to be larger than 8.5 inches wide, so recipients who try to print the email
(without manually changing the print to landscape) get part of the image cut
off.
Is there a way to force an email message's default print setting to
landscape, or is that /only/ handled by the recipient's instance of Outlook?
Many thanks,
Keith
Function EmbeddedHTMLGraphicDemo(SendToName As String, SendFileCount As
Integer)
' 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 MAPI.Session
' CDO objects
Dim oMsg As MAPI.Message
Dim oAttachs As MAPI.Attachments
Dim oAttach As MAPI.Attachment
Dim colFields As MAPI.Fields
Dim oField As 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
FName = "c:\" & SendToName
FExt = ".gif"
For n = 1 To SendFileCount
Set l_Attach = colAttach.Add(FName & CStr(n) & FExt)
Next
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
For n = 1 To SendFileCount
Set oAttach = oAttachs.Item(n)
Set colFields = oAttach.Fields
Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg") '??
Set oField = colFields.Add(&H3712001E, "myident" & CStr(n))
Next
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
HTMLString = ""
For n = 1 To SendFileCount
HTMLString = HTMLString & "<IMG align=baseline border=0 hspace=0
src=cid:myident" & _
CStr(n) & ">" & "<br> </br>" & "In your reply, please enter
updates for the record above here:" & _
"<br> </br> <br> </br>"
Next
l_Msg.HTMLBody = HTMLString
l_Msg.To = SendToName
l_Msg.Subject = "Next Actions - please respond by 9am Thursday this week -
THANKS"
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 Function
