Oulook Email Send Problem

[robcarr]

Hi,

I am using the following code successfully to send an email without any assistance every 2 hours to the distribution list

strHTML = "Hi," & vbCrLf _
    & "The Data has been updated, please remember that there may be changes as this has been automatically generated." & vbCrLf & vbCrLf _
    & "Below is a snapshot of Technical Skill data." & vbCrLf & vbCrLf _
    & "Service Level          " & slvl & vbCrLf _
    & "AHT                       " & saht & vbCrLf _
    & "Forecast Variance  " & sfor & vbCrLf _
    & "Calls Offered           " & soff & vbCrLf _
    & "Calls Abandoned     " & saba & vbCrLf & vbCrLf _
    & "Calls Abandoned %   " & saba22 & vbCrLf & vbCrLf _
    & "Below is a snapshot." & vbCrLf & vbCrLf _
    & "Service Level          " & slvl2 & vbCrLf _
    & "AHT                       " & saht2 & vbCrLf _
    & "Forecast Variance  " & sfor2 & vbCrLf _
    & "Calls Offered           " & soff2 & vbCrLf _
    & "Calls Abandoned     " & saba2 & vbCrLf & vbCrLf _
    & "Calls Abandoned %   " & saba23 & vbCrLf & vbCrLf _
    & "Regards and Thanks" & vbCrLf & vbCrLf _
    & "Rob." & vbCrLf & vbCrLf

pname = "U:\Private\Flash Reports\" & Format(ddate, "dd.mm.yy") & " " & Format(rstime, "hh.mm.ss") & ".xls"
blnSuccessful = FnSafeSendEmail("test@test.com", _
                        "Flash Update Reports for  " & Format(ddate, "dd.mm") & " " & rstime & ".", _
                        strHTML, _
                        pname & "; ", _
                        "test@test.com")

I am struggling to add a picture within the email string.

I use the following coding successfully to add a picture to an email and to add text within the email, but i cannot incorporate the coding below to use the "blnSuccessful" format above to sent automatically, as the coding below doesnt always send automatically.

Dim oOutlookApp As Object
Dim oOutlookMessage As Object
Dim oFSObj As Object
Dim strHTMLbody As String
Dim strTempFilePath As String
Dim oOutlookAppAttach As Object
Dim oOutlook_Att As Object
Dim strEntryID As String
Dim oSession As Object

'// Use late binding    'Reference CDO
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

'// Sheet
Dim objPict As Object
Dim MyChart As Chart
Dim rgImgSend As Range


'// Select the range to be sent
On Error Resume Next
If Format(Date, "dddd") = "Tuesday" Then
Set rgImgSend = Range("a3:m51")
Else
Set rgImgSend = Range("a20:m51")
End If
If rgImgSend Is Nothing Then Exit Sub
On Error GoTo 0

'// Set Range as an Image!
rgImgSend.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
Set objPict = Selection

'// Get the Temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")

strTempFilePath = oFSObj.GetSpecialFolder(2) & "\MyImg.gif"
    
With objPict
    .Copy
    Set MyChart = ActiveSheet.ChartObjects.Add(1, 1, .Width + 8, .Height + 8).Chart
End With

'// Export the chart. We'll use it later
With MyChart
    .Paste
    .Export strTempFilePath
    .Parent.Delete
    objPict.Delete
End With

'// Create an instance of Outlook (or use existing instance if it already exists)
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")

If Err.Number <> 0 Then
    Set oOutlookApp = CreateObject("Outlook.Application")
    '// We need the Application Open in order to NOT show as attachment
    Shell oOutlookApp, vbMaximizedFocus
End If
On Error GoTo 0

'// Create a mail item
Set oOutlookMessage = oOutlookApp.CreateItem(0)
Set oOutlookAppAttach = oOutlookMessage.Attachments
'// add graphic as attachment to Outlook message
'// change path to graphic as needed
Set oOutlook_Att = oOutlookAppAttach.Add(strTempFilePath)

'// Lets save the msg, this is so that the EntryID property
'// is set.
oOutlookMessage.Close olSave

strEntryID = oOutlookMessage.EntryID

Set oOutlookMessage = Nothing
Set oOutlookAppAttach = 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 = oFieldsColl.Add (name, Class [, value] [, PropsetID] )
Set oField = colFields.Add(CdoPR_ATTACH_MIME_TAG, "image/gif")
Set oField = colFields.Add(&H3712001E, "MyIdent")
oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True

oMsg.Update

'// Here put any HTML you want - this is just an example
strHTMLbody = strHTMLbody & "<b>Below is the Latest Absence Update</b><br><br>"
strHTMLbody = strHTMLbody & "<IMG align=baseline border=0 hspace=0 SRC=cid:MyIdent>"
'// Get the Outlook MailItem again
Set oOutlookMessage = oOutlookApp.GetNamespace("MAPI").GetItemFromID(strEntryID)

'// add HTML content -- the <IMG> tag
With oOutlookMessage
    .To = "test@test.com"
    .CC = "test@test.com"
    .Subject = "Daily Absence Update"
    .HTMLBody = strHTMLbody
    .Close (olSave)
    .Display
End With
SendKeys "%{s}", True
'// cleanup
Set oFSObj = Nothing
Set oField = Nothing
Set colFields = Nothing
Set oMsg = Nothing
Set oAttachs = Nothing
Set oAttach = Nothing
Set colFields = Nothing

oSession.Logoff

Set oSession = Nothing
Set oOutlookApp = Nothing
Set oOutlookMessage = Nothing

Kill strTempFilePath

I need to try and incorporate the 2nd coding into the first so Ic an basically add a picture into an email body and the email go automatically.

Any help suggestions greatly appreciated

Hope this is of use, Rob.

 

[yooneek]

A couple of suggestions:

1) For adding the string to your Body, I'd suggest something like this .GetInspector.WordEditor.Range(Start:=0, End:=0).Paste
I've found that using the Word related functions easier than HTML refferencing. Also, if you are using variable body text combined with variable images, you can continue to use this same command just building the message from bottom up.

(Note: I think the email needs to be Displayed before the Paste will work, see below suggestion 3)


2) Instead of Closing and Saving the email and then using the entryID, you could just enclose all of the subsequent code in a with statement

Set oOutlookMessage = oOutlookApp.CreateItem(0)
With oOutlookMessage
...

As long as you are still talking to the email there shouldn't be any issue of loosing it


3) Instead of Close/Saveing the email and then using SendKeys "%{s}", True
.Display
.Recipients.ResolveAll
.Send

??

 

[robcarr]

both of my ways that are above avoid any security prompts within outlook, I was under the impression that option 3 would generate a security prompt.

I will look into points 1 and 2 - thanks for some suggestions.

Hope this is of use, Rob.

 

[robcarr]

HI,

I am still struggling with and have noticed teh sendkeys method does not work on a locked pc, but is fine if the pc is unlocked.

Has anyone got round this method of using send keys to send an email with a pc screen locked.

Hope this is of use, Rob.