Email from Excel

S

samitnair

Board Regular
Joined
Jul 5, 2010
Messages
155
Hello,

I reviewed suggestions provided in Ron de Bruin page. I need help in streamlining the below code. I need to Send email to a list of users. I did changes which I guess is not working. :confused:


  • The code does not pull the signature even after me changing the sign file name
  • I need the VBA to pull the company name and contact person from the excel sheet and insert in the email body (Highlighted in the code). Sample of the excel sheet is shown below

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]Company Name[/TD]
[TD="align: center"]Client Name[/TD]
[TD="align: center"]Email[/TD]
[TD="align: center"]Yes/No[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"]Software INC[/TD]
[TD="align: center"]George[/TD]
[TD="align: center"]xyz@gmail.com[/TD]
[TD="align: center"]Yes[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]Dell INC[/TD]
[TD="align: center"]Michael[/TD]
[TD="align: center"]abc@dell.com[/TD]
[TD="align: center"]No[/TD]
[/TR]
</tbody>[/TABLE]



Code: 
[FONT=Verdana]Sub Test1()[/FONT]
[FONT=Verdana]   Dim OutApp As Object[/FONT]
[FONT=Verdana]   Dim OutMail As Object[/FONT]
[FONT=Verdana]   Dim cell As Range[/FONT]
[FONT=Verdana]   Dim strbody As String[/FONT]
[FONT=Verdana]   Dim Signature As String[/FONT]
[FONT=Verdana]  Application.ScreenUpdating = False[/FONT]
[FONT=Verdana]   Set OutApp = CreateObject("Outlook.Application")[/FONT]
[FONT=Verdana]   On Error GoTo cleanup[/FONT]
[FONT=Verdana]   For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)[/FONT]
[FONT=Verdana]       If cell.Value Like "?*@?*.?*" And _[/FONT]
[FONT=Verdana]          LCase(Cells(cell.Row, "D").Value) = "yes" Then[/FONT]
[FONT=Verdana]          Set OutMail = OutApp.CreateItem(0)[/FONT]
[FONT=Verdana]           On Error Resume Next[/FONT]
[FONT=Verdana]           With OutMail[/FONT]
[FONT=Verdana]               .To = cell.Value[/FONT]
[FONT=Verdana]               .Subject = "Meeting Invite to [[B]Company Name] [/B]" & cell.Offset(0, -1).Value 'Refer value from column A (company name)[/FONT]
[FONT=Verdana]               .HTMLBody = "<style> body{color:black;font-family:Calibri (Body);font-size: 12pt;} </style>" & _[/FONT]
[FONT=Verdana]                           "******>Hello [[B][COLOR=#ff0000]contact person[/COLOR][/B]],

 " & _[/FONT]
[FONT=Verdana]                           "I am the delivery manager associated to" [[COLOR=#ff0000][B]Company Name] [/B][/COLOR]and I would like to conduct a meeting with you and discuss the below points." & [/FONT]
[FONT=Verdana]       SigString = Environ("appdata") & _[/FONT]
[FONT=Verdana]               "\Microsoft\Signatures\Sign.txt"[/FONT]
[FONT=Verdana]       If Dir(SigString) <> "" Then[/FONT]
[FONT=Verdana]           Signature = GetBoiler(SigString)[/FONT]
[FONT=Verdana]       Else[/FONT]
[FONT=Verdana]       Signature = ""[/FONT]
[FONT=Verdana]       End If[/FONT]
[FONT=Verdana]               'You can add files also like this[/FONT]
[FONT=Verdana]               '.Attachments.Add ("C:\test.txt")[/FONT]
[FONT=Verdana]               .send[/FONT]
[FONT=Verdana]           End With[/FONT]
[FONT=Verdana]           On Error GoTo 0[/FONT]
[FONT=Verdana]           Set OutMail = Nothing[/FONT]
[FONT=Verdana]       End If[/FONT]
[FONT=Verdana]   Next cell[/FONT]
[FONT=Verdana]
[/FONT]
[FONT=Verdana]cleanup:[/FONT]
[FONT=Verdana]   Set OutApp = Nothing[/FONT]
[FONT=Verdana]   Application.ScreenUpdating = True[/FONT]
[FONT=Verdana]End Sub[/FONT]
[FONT=Verdana]Function GetBoiler(ByVal sFile As String) As String[/FONT]
[FONT=Verdana]'**** Kusleika[/FONT]
[FONT=Verdana]   Dim fso As Object[/FONT]
[FONT=Verdana]   Dim ts As Object[/FONT]
[FONT=Verdana]   Set fso = CreateObject("Scripting.FileSystemObject")[/FONT]
[FONT=Verdana]   Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)[/FONT]
[FONT=Verdana]   GetBoiler = ts.readall[/FONT]
[FONT=Verdana]   ts.Close[/FONT]
[FONT=Verdana]End Function[/FONT]


I would appreciate your help and thank you in advance ;).

Regards
Samit Nair
 
Last edited:

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
.
Code: 
Option Explicit


Sub PC_Email()
    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody, SigString, Signature As String
    Dim MailAttachments As String
    Dim cell As Variant '                             Not previously DIM'd
    Dim GetBoiler As Object
    
    Sheets("Sheet1").Select '                         Edit as required
    Range("A1").Select
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
  
   'On Error GoTo cleanup
    For Each cell In Columns("C").Cells
        If cell.Value Like "?*@?*.?*" And _
            LCase(Cells(cell.Row, "D").Value) = "yes" Then
              
            With Application.ActiveSheet
                MailAttachments = Cells(cell.Row, "E").Value
            End With
            
        
            Set OutMail = OutApp.CreateItem(0)
            
                On Error Resume Next
                                  
                With OutMail
                
                    .To = cell.Value
                    .Subject = "Meeting Invite to " & Cells(cell.Row, "A").Value  'Refer value from column A (company name)
                    .HTMLBody = "" & _
                               "******> Hello ," & Cells(cell.Row, "B") & ", " & _
                               "I am the delivery manager associated to " & Cells(cell.Row, "A") & " and I would like to conduct a meeting with you and discuss the below points."
                    '.Attachments.Add MailAttachments
                    .Display
                    'Or use .Send
                    
                End With
                         SigString = Environ("appdata") & " Microsoft\Signatures\Sign.txt"
                    If Dir(SigString) <> "" Then
                        Signature = GetBoiler(SigString)
                    Else
                        Signature = ""
                    End If
                    
                
                On Error GoTo 0
        End If
    Next




cleanup:
    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    
End Sub

I'm not certain about the Signature lines of code ....
 
Upvote 0
Hello Logit,

Thank you for the update and I really appreciate your time but a signature feature is a mandate and would be a added value to the script and let me know if you have any suggestions

Regards
 
Upvote 0
.
Rather than use another file to create your email signature, you could just include it within the body of the email several rows lower than the body text. Try this :

Code: 
Option Explicit


Sub PC_Email()
    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody, SigString, Signature As String
    Dim MailAttachments As String
    Dim cell As Variant '                             Not previously DIM'd
    Dim GetBoiler As Object
    
    Sheets("Sheet1").Select '                         Edit as required
    Range("A1").Select
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
 
   'On Error GoTo cleanup
    For Each cell In Columns("C").Cells
        If cell.Value Like "?*@?*.?*" And _
            LCase(Cells(cell.Row, "D").Value) = "yes" Then
              
            With Application.ActiveSheet
                MailAttachments = Cells(cell.Row, "E").Value
            End With
            
        
            Set OutMail = OutApp.CreateItem(0)
            
                On Error Resume Next
                                  
                With OutMail
                
                    .To = cell.Value
                    .Subject = "Meeting Invite to " & Cells(cell.Row, "A").Value  'Refer value from column A (company name)
                    .HTMLBody = "" & _
                                "Hello ," & Cells(cell.Row, "B") & ", " & "

" & _
                                "I am the delivery manager associated to " & Cells(cell.Row, "A") & " and I would like to conduct a meeting with you and discuss the below points." & "

" & _
                                "

" & _
                                "

" & _
                                "

" & _
                                "**************************************************************************************************************" & "

" & _
                                "This is your signature file. It will always be 7 rows below whatever text you add in the macro code."
                                'To add another line in your message or signature without skipping a row, end the line of text with
                                'a  quotation symbol and then an ampersand and an underscore. Ex:   end of text." & _
                    '.Attachments.Add MailAttachments
                    .Display
                    'Or use .Send
                    
                End With
                
                On Error GoTo 0
        End If
    Next

cleanup:
    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
Hello Logit,

I am figuring out a solution for the signature to call an email before so that the default signature is loaded or add a picture (signature) at the bottom. I also wanted to go one step further and understand

1. how can we utilize the .senton syntax and capture at what time was the email sent like a logging feature
2. Can we tag the email so that next time when I run the code it replies to same conversation
3. Can we save a copy of the sent emails in a particular folder.
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Question Question
Add Signature to Email Macro
Replies
1
Views
331
starl
starl
B
  • Question Question
font size in outlook email (12 points doesn't work)
2
Replies
13
Views
289
basb87
B
S
  • Solved
Tweak to VBA email code
Replies
3
Views
757
rollis13
rollis13
S
  • Question Question
VBA sending an email of two conditions are met
Replies
5
Views
139
mumps
mumps
K
  • Solved
Macro : Email Worksheet As PDF
Replies
3
Views
420
Domenic
D

Forum statistics

Threads
1,223,910
Messages
6,175,320
Members
452,635
Latest member
laura12345

Share this page

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