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.
[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]
I would appreciate your help and thank you in advance .
Regards
Samit Nair
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.
- 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: