Find totals and send emails to different people

**Nonboff** · 07-07-2009, 05:31 AM

Anybody had any luck with this? Maybe today will be the day!!
Dean

**salimudheen** · 07-07-2009, 09:47 AM

Hi,

Add this code to include in your code before for loop.

'Stuff to add image
    Dim objImage As Object
    Dim strPic As String
    Dim strImagePath As String
    strImagePath = "" 'Give your image path
    Const cdoReferenceTypeName = 1
    
    Set objImage = iMsg.AddRelatedBodyPart(strImagePath, "mypic.jpg", cdoReferenceTypeName)
    objImage.Fields.Item("urn:schemas:mailheader:Content-ID") = "<mypic.jpg>"
    objImage.Fields.Update
    strPic = "<img src=""cid:mypic.jpg"" alt=""Logo"" />"

And also you remove the "TextBody".
You use "HtmlBody" for this.

 '.TextBody = strbody
               .HtmlBody = "<html><p>" & strbody & "</p><br/>" & strPic & "</html>"

**Nonboff** · 07-07-2009, 10:36 AM

Hi Salim

I have made the adjustments required but it is falling over at point indicated below:

Option Explicit
Sub CDO_Mail_Small_Text()
    Dim wsMain As Excel.Worksheet
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim strToaddress As String
    Dim index As Long
    Dim Flds As Variant
    Dim objImage As Object
    Dim strPic As String
    Dim strImagePath As String
    strImagePath = "J:\Amos\Advantage CIS\Unit Trust\MERZY"
    Const cdoReferenceTypeName = 1
    
     
    Set objImage = iMsg.AddRelatedBodyPart(strImagePath, "mypic.jpg", cdoReferenceTypeName) ' run time error '91' Object variable or With Block variable not set
    objImage.Fields.Item("urn:schemas:mailheader:Content-ID") = "<mypic.jpg>"
    objImage.Fields.Update
    strPic = "<img src=""cid:mypic.jpg"" alt=""Logo"" />"

    
    
    Const UAFEQ1TOT = "UAFEQ1 Total"
    Const ALPROPTOT = "ALPROP Total"
    Const UAFEQ1TOTEMAIL = "deanm@advantage.am"
    Const ALPROPTOTEMAIL = "deanm@advantage.am"
    
    
    
    
    
    'Set Source Worksheet name to the work sheet object
    Set wsMain = ActiveSheet
    
    'Set outline group level (I assume its maximum level is 3)
    wsMain.Outline.ShowLevels 3


    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    '    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
                       = "s-adv-mail.Cyberark.co.za"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
    
   Set objImage = iMsg.AddRelatedBodyPart(strImagePath, "J:\Amos\Advantage CIS\Unit Trust\MERZY\mypic", cdoReferenceTypeName)
    objImage.Fields.Item("urn:schemas:mailheader:Content-ID") = "<mypic.jpg>"
    objImage.Fields.Update
    strPic = "<img src=""cid:mypic.jpg"" alt=""Logo"" />"
    
    For index = 2 To wsMain.UsedRange.Rows.Count
        If wsMain.Cells(index, 1).Value = UAFEQ1TOT Or wsMain.Cells(index, 1).Value = ALPROPTOT Then
            If wsMain.Cells(index, 1).Value = UAFEQ1TOT And wsMain.Cells(index, 5).Value > 0 Then
                strToaddress = UAFEQ1TOTEMAIL
                strbody = "Please see deposit of " & wsMain.Cells(index, 5).Value
            ElseIf wsMain.Cells(index, 1).Value = UAFEQ1TOT And wsMain.Cells(index, 5).Value < 0 Then
                strToaddress = UAFEQ1TOTEMAIL
                strbody = "Please see withdrawal of " & wsMain.Cells(index, 5).Value
            ElseIf wsMain.Cells(index, 1).Value = ALPROPTOT And wsMain.Cells(index, 5).Value > 0 Then
                strToaddress = ALPROPTOTEMAIL
                strbody = "Please see deposit of " & wsMain.Cells(index, 5).Value
            ElseIf wsMain.Cells(index, 1).Value = ALPROPTOT And wsMain.Cells(index, 5).Value < 0 Then
                strToaddress = ALPROPTOTEMAIL
                strbody = "Please see withdrawal of " & wsMain.Cells(index, 5).Value
            End If
            
            With iMsg
                Set .Configuration = iConf
                .to = strToaddress
                .CC = ""
                .BCC = ""
                .From = """Dean Merz"" <deanm@advantage.am>"
                .Subject = "Important message"
                .HtmlBody = "<html><p>" & strbody & "</p><br/>" & strPic & "</html>"
                .Send
            End With
        End If
    Next

End Sub

Any ideas?

Are you by any chance able to do the loop mentioned in my previous post above, where names in column 1 are emailed the value in column D (email addresses saved on either tab2 or in a file saved in a folder?

Dean