Can anyone help add my signature to this VBA? It's currently creating the e-mail, adding my hyperlink and adding my cells requested to the body but I can't get the signature added at the bottom... When I open a blank e-mail, my signature is there.
Sub SendScrubFile()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim txtdate As String
Dim strbody As String
Dim strbody2 As String
Dim strbody3 As String
Dim strbody4 As String
Dim signature As String
Set rng = Nothing
On Error Resume Next
Set rng = wsstart.Range("c23:e31").SpecialCells(xlCellTypeVisible)
txtdate = Format(Now, "m") & "/" & Format(Now, "d") & "/" & Format(Now, "yy") & " " & Format(Now, "hAM/PM")
strbody = "Hello Team," & "<br><br>" & "Please update grids in the latest shared document within the folder below: <br><br>"
strbody4 = "<a href=""" & "\\abc.com\Shares\" & """>" & "\\ccx.abc.com\Shares\Teams\CSC\Staffing\Confidential\MSOC\DailyReports\" & "</a>"
strbody2 = "<br><br>" & "Thank you," & "<br>"
strbody3 = "<BODY STYLE=font-size:11pt;font-family:Calibri>"
On Error Resume Next
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
signature = OutMail.body
On Error Resume Next
With OutMail
.Display
.To = "test@google.com"
.CC = ""
.BCC = ""
.Subject = "Scrub Alert " & txtdate
.HTMLBody = strbody3 & strbody & strbody4 & RangetoHTML(rng) & strbody2 & signature
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Sub SendScrubFile()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim txtdate As String
Dim strbody As String
Dim strbody2 As String
Dim strbody3 As String
Dim strbody4 As String
Dim signature As String
Set rng = Nothing
On Error Resume Next
Set rng = wsstart.Range("c23:e31").SpecialCells(xlCellTypeVisible)
txtdate = Format(Now, "m") & "/" & Format(Now, "d") & "/" & Format(Now, "yy") & " " & Format(Now, "hAM/PM")
strbody = "Hello Team," & "<br><br>" & "Please update grids in the latest shared document within the folder below: <br><br>"
strbody4 = "<a href=""" & "\\abc.com\Shares\" & """>" & "\\ccx.abc.com\Shares\Teams\CSC\Staffing\Confidential\MSOC\DailyReports\" & "</a>"
strbody2 = "<br><br>" & "Thank you," & "<br>"
strbody3 = "<BODY STYLE=font-size:11pt;font-family:Calibri>"
On Error Resume Next
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
signature = OutMail.body
On Error Resume Next
With OutMail
.Display
.To = "test@google.com"
.CC = ""
.BCC = ""
.Subject = "Scrub Alert " & txtdate
.HTMLBody = strbody3 & strbody & strbody4 & RangetoHTML(rng) & strbody2 & signature
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
