Reporter | |
VBOffice Reporter is an easy to use tool for data analysis and reporting in Outlook. A single click, for instance, allows you to see the number of hours planned for meetings the next month. |
It is possible to embed a picture in an HTML formatted email so that it is displayed in the text area. if you do that by using Outlook's object model, not the pictures are sent with the email but the file path only. That is if the file path isn't valid on the receiver's computer (which it most likely is not), then the receiver cannot see the picture but only the red cross.
By using the Redemption you can really embed a picture so that it's sent with the email. This works also with an audio file, which will be played when the user opens the email in HTML format. Even animated GIFs are possible (at least with Outlook 2003).
I got the idea for the sample from Dmitry himself.
Additionally needed functions: Create a Redemption SafeMailItem
Private Type EmbeddedObj Key As String Type As String Source As String Tag As String Description As String End Type Private m_SafeMail As Object Private m_Buffer As String Private m_StartPos As Long Private m_EndPos As Long Public Sub AufrufBeispiel() Dim ImageMail As MailItem Dim AudioMail As MailItem Dim imgf$, audf$ imgf = "d://laugh.gif" audf = "d://qopen.wav" Set ImageMail = Application.CreateItem(olMailItem) ImageMail.BodyFormat = olFormatHTML Set AudioMail = ImageMail.Copy ImageMail.Subject = "test image" ImageMail.HTMLBody = "Image of the day: @0 - text continues here" ImageMail.Display AddEmbeddedAttachment ImageMail, imgf, "@0", "(Image of the day)" AudioMail.Subject = "test audio" AudioMail.Display AddEmbeddedAttachment AudioMail, audf End Sub ' -> File: Full name of the file you want to embed. ' suported types: ' - Image: "gif", "jpg", "jpeg", "bmp", "png" ' - Audio: "wav", "wma" ' -> [PositionID]: For images you can determine the position by a placeholder ' -> [Description]: alt text for images Public Sub AddEmbeddedAttachment(Mail As Outlook.MailItem, _ File As String, _ Optional PositionID As String, _ Optional Description As String _ ) On Error GoTo AUSGANG Dim Obj As EmbeddedObj Mail.Save Set m_SafeMail = CreateSafeItem(Mail) m_Buffer = m_SafeMail.HTMLBody Obj.Source = File Obj.Description = Description Obj.Type = GetContentType(GetExtension(File)) Obj.Key = GetNewID FindPosition PositionID Select Case left$(Obj.Type, 1) Case "i" ' Image CreateImageTag Obj Case "a" ' Audio CreateAudioTag Obj Case Else ' Nicht unterstützt GoTo AUSGANG End Select AddAttachment Obj InsertTagIntoMail Obj.Tag AUSGANG: ReleaseSafeItem m_SafeMail End Sub Private Function GetContentType(Extension As String) As String Select Case Extension Case "wav", "wma" GetContentType = "audio/" & Extension Case "avi" GetContentType = "video/" & Extension Case "gif", "jpg", "jpeg", "bmp", "png" GetContentType = "image/" & Extension End Select End Function Private Function GetExtension(File As String) As String GetExtension = Mid$(File, InStrRev(File, ".") + 1) End Function Private Function GetNewID() As String Randomize GetNewID = CStr(Int((99999 - 10000 + 1) * Rnd + 10000)) End Function Private Sub FindPosition(Find As String) Dim posAnf As Long Dim posEnd As Long If Len(Find) Then posAnf = InStr(m_Buffer, Find) If posAnf Then posEnd = posAnf + Len(Find) - 1 End If End If If posAnf = 0 Then posAnf = InStr(1, m_Buffer, "
", vbTextCompare) If posAnf = 0 Then posAnf = Len(m_Buffer) + 1 End If posEnd = posAnf - 1 End If m_StartPos = posAnf m_EndPos = posEnd End Sub Private Sub CreateImageTag(Obj As EmbeddedObj) Obj.Tag = "<" & "img src='cid:" & Obj.Key Obj.Tag = Obj.Tag & "' align=baseline border=0 hspace=0" If Len(Obj.Description) Then Obj.Tag = Obj.Tag & " alt='" & Obj.Description & "'>" Else Obj.Tag = Obj.Tag & ">" End If End Sub Private Sub CreateAudioTag(Obj As EmbeddedObj) Obj.Tag = "<" & bgsound src='cid:" & Obj.Key & "'>" End Sub Private Sub AddAttachment(Obj As EmbeddedObj) Dim Attachment As Object 'Redemption.Attachmentment Dim PR_HIDE_ATTACH As Long Const PT_BOOLEAN As Long = 11 PR_HIDE_ATTACH = _ m_SafeMail.GetIDsFromNames("{00062008-0000-0000-C000-000000000046}", _ &H8514) Or PT_BOOLEAN m_SafeMail.Fields(PR_HIDE_ATTACH) = True Set Attachment = m_SafeMail.Attachments.Add(Obj.Source) Attachment.Fields(&H370E001E) = Obj.Type Attachment.Fields(&H3712001E) = Obj.Key Set Attachment = Nothing End Sub Private Sub InsertTagIntoMail(Tag As String) m_Buffer = left$(m_Buffer, m_StartPos - 1) _ & Tag & _ right$(m_Buffer, Len(m_Buffer) - m_EndPos) m_SafeMail.HTMLBody = m_Buffer End Sub
ReplyAll | |
ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail. |