Adding Outlook Signature

craigw02

New Member
Joined
Sep 12, 2013
Messages
26
Hi Guys,

Im trying to add a signature to the code below which relates to ANYONE sending out this email so need the code to look at whoever would send this out and insert the correct signature? Any ideas?

Code:
Sub CreateMail()
    
    Dim objOutlook As Object
    Dim cell       As Range
    
    Set objOutlook = CreateObject("Outlook.Application")
        
    For Each cell In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If UCase(cell.Range("G1").Value) = "YES" Then
            With objOutlook.CreateItem(0)
                .To = cell.Value
                .CC = cell.Range("C1").Value
                .Attachments.Add cell.Range("D1").Value
                .Subject = cell.Range("E1").Value
                .body = cell.Range("H1").Value
                .Display    'Instead of .Display, you can use .Send to send the email _
                             or .Save to save a copy in the drafts folder
            End With
        End If
    Next cell
    
    Set objOutlook = Nothing
    
End Sub
 
I got it working ok.
You should post what you are using now as my posts may have caused confusion and you may have missed something.
 
Upvote 0

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
I got it working ok.
You should post what you are using now as my posts may have caused confusion and you may have missed something.

OK, perhaps the following will be successful.
Added a few new lines based on this article regarding Office03...HTMLBody Property

Code:
Sub CreateMail2()          Dim objOutlook As Object     Dim cell       As Range          Set objOutlook = CreateObject("Outlook.Application")                   For Each cell In Range("A1", Range("A" & Rows.Count).End(xlUp))         If UCase(cell.Range("G1").Value) = "YES" Then             With objOutlook.CreateItem(0)                 .To = cell.Value                 .CC = cell.Range("C1").Value                 .Attachments.Add cell.Range("D1").Value                 .Subject = cell.Range("E1").Value                                  .BodyFormat = olFormatHTML                 .Display     'Have to display first to capture existing signature                 .htmlbody = "<HTML><BODY>" & cell.Range("H1").Value & ";<BR></BODY></HTML&gt" & .htmlbody                 End With         End If     Next cell          Set objOutlook = Nothing      End Sub</pre>




Used the above code and great I have the text and my signature now attached only problem I have now is my text is on a continuos line with no carriage returns in the email, is there a way to correct this as this was the purpose of cell H1?

Thanks
 
Upvote 0
This is the code im using now!

Code:
Sub CreateMail3()
    
    Dim objOutlook As Object
    Dim cell       As Range
    
    Set objOutlook = CreateObject("Outlook.Application")
        
    
    For Each cell In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If UCase(cell.Range("G1").Value) = "YES" Then
            With objOutlook.CreateItem(0)
                .To = cell.Value
                .CC = cell.Range("C1").Value
                .Attachments.Add cell.Range("D1").Value
                .Subject = cell.Range("E1").Value
                
                .BodyFormat = 2
                .Display     'Have to display first to capture existing signature
                .htmlbody = "<HTML><BODY>" & cell.Range("H1").Value & "<BR></BODY></HTML&gt>" & .htmlbody
               End With
        End If
    Next cell
    
    Set objOutlook = Nothing
    
End Sub
 
Upvote 0
Not sure what you are using for your line break in cell H1, but one of the following two replacements should work...

instead of
Code:
cell.Range("H1").Value

use either (probably)
Code:
Replace(cell.Range("H1").Value,Chr(13),"<BR>")
or (possibly)
Code:
Replace(cell.Range("H1").Value,Chr(10),"<BR>")

The decision of which to use will depend on what line break character you are using in column H within the formula.
This replaces the Excel line break character with the HTML code for a line break
 
Last edited:
Upvote 0
Since there has been alot of confusion on my posts, this should be the final code...

Code:
Sub CreateMail3()
    
    Dim objOutlook As Object
    Dim cell       As Range
    
    Set objOutlook = CreateObject("Outlook.Application")
        
    
    For Each cell In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If UCase(cell.Range("G1").Value) = "YES" Then
            With objOutlook.CreateItem(0)
                .To = cell.Value
                .CC = cell.Range("C1").Value
                .Attachments.Add cell.Range("D1").Value
                .Subject = Replace(cell.Range("E1").Value, Chr(13), "<BR>")
                
                .BodyFormat = 2
                .Display     'Have to display first to capture existing signature
                .htmlbody = "<HTML><BODY>" & cell.Range("H1").Value & "<BR></BODY></HTML>" & .htmlbody
               End With
        End If
    Next cell
    
    Set objOutlook = Nothing
    
End Sub
 
Upvote 0
Hi BiocideJ,

Spot on mate, works a treat now, thanks for your great help, much appreciated!

Thanks

Craig
 
Upvote 0
Great. Glad we finally got it sorted out.
Thanks for replying back that the code worked.
 
Upvote 0

Forum statistics

Threads
1,214,976
Messages
6,122,541
Members
449,089
Latest member
davidcom

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top