Issue with HYPERLINK - excel

It is probably a very small thing I am missing, but I can't seem to spot the issue.
Sub sendemail()
'Save the form with todays date
Application.Save Format(Now, "dd-mm-yy") & ".xls"
'Create the email
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<HTML><BODY>"
strbody = strbody & "<A href= http://ne-xxx.xxx.xxx.xxx.biz/ASP/SFP/BHGP/xxUK-OPS/Shared%20Documents/xxx/AllItems.aspx?RootFolder=%2fAxP%2fASP%2fBP%2fNUK%2dOPS%2fShared%20Documents%2f60%2e%20Shift%20Schedule&FolderCTID=&View=%7b1A03DBA9%2d7CEB%2d466F%2d8EA8%2dDDE03D95CDC0%7d>URL</A>"
strbody = strbody & "</BODY></HTML>"
On Error Resume Next
With OutMail
.To = "[xxxx#xx]"
.cc = ""
.BCC = ""
.Subject = "New Holiday Request on " & Format(Now(), "dd/mm/yyyy") & " by " & Range("C2") & ""
.Body = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Debug.Print strbody
End Sub
End result should just be a hyperlink in an email...but it's displaying:
http://ne-xxx.xxxx.xxx.xxxx.xxx/sSP/SXP/BJHJP/xxx-OPS/Shared%20Documents/Forms/AllItems.aspx?RootFolder=%2fASP%2fSsP%2foP%2fNBXUK%2dOPS%2fShared%20Documents%2f60%2e%20Shift%20Schedule&FolderCD=&View=%7b1A03DBA9%2d7CEB%2d466F%2d8EA8%2dDDE03D95CDC0%7d>URL

please use below code block
strbody = strbody & "URL"
.HTMLBody = strbody instead of Body

Change
.Body = strbody
to
.HTMLBody = strbody
My sample vbs code worked with or without the quotes
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<HTML><BODY>"
strbody = strbody & "<A href=http://ne-xxx.xxx.xxx.xxx.biz/ASP/SFP/BHGP/xxUK-OPS/Shared%20Documents/xxx/AllItems.aspx?RootFolder=%2fAxP%2fASP%2fBP%2fNUK%2dOPS%2fShared%20Documents%2f60%2e%20Shift%20Schedule&FolderCTID=&View=%7b1A03DBA9%2d7CEB%2d466F%2d8EA8%2dDDE03D95CDC0%7d>URL</A>"
strbody = strbody & "</BODY></HTML>"
With OutMail
.To = "pankaj.jaju#stackoverflow.com"
.HTMLBody = strbody
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing

Related

Send Outlook Email with some Bold Text

I have code that opens up an Outlook email with the content of the mail body, but none of the format is working.
In the email, it just shows up as a string Like:
<strong>Bold this part</strong>Unbold this text
<b>This text bold</b>Test
I have been searching answers here, but none of them work.
Here is my code so far:
Sub Send_email()
Dim OutApp As Object
Dim OutMail As Object
Dim MailBody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
MailBody = "First line of email" & vbNewLine & vbNewLine & _
"<strong>Bold this part</strong>" & "Unbold this text" & vbNewLine & _
"<b>This text bold</b>" & "Test"
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Email Subject"
.Body = MailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Use MailItem.HTMLBody instead of MailItem.Body.
Returns or sets a String representing the HTML body of the specified item. Read/write.
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Email Subject"
.HTMLBody = MailBody
.Display 'or use .Send
End With

How insert hyperlink from a column into Outlook email body

I have column "AB" that has a hyperlink in which I will like to include in a email through VBA.
The hyperlink changes per line. I am able to pull the column through text however the email is not showing the hyper link.
How can I get it to show as a hyperlink?
Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strto = Cells(FormulaCell.Row, "Y").Value
strcc = ""
strbcc = ""
strsub = "MCR FORM"
strbody = "Hi " & Cells(FormulaCell.Row, "O").Value & vbNewLine & vbNewLine & _
"You have a open MCR that needs attention. Please Find the attachted MCR Form for material : " & Cells(FormulaCell.Row, "E").Value & _
vbNewLine & vbNewLine & Cells(FormulaCell.Row, "AB").Value & vbNewLine & vbNewLine & "Thank you!"
With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
'You can add a file to the mail like this
.Attachments.Add ("P:\Inventory Control\Public\MCR Form Master.xlsm")
.Display ' or use .Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
vbNewLine & vbNewLine & Cells(FormulaCell.Row, "AB").Value &
I believe the code above needs to be reference a HREF link??
Work with HTMLBody Property
Example will show Hyperlink Click Here
.HTMLBody = " Click Here "
Or This will show the value A1 as link
"" & Sht.Range("A1") & "" &
Full Code
Option Explicit
Public Sub Example()
Dim Sht As Excel.Worksheet
Set Sht = ThisWorkbook.Worksheets("Sheet1")
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.HTMLBody = "Hi " & vbNewLine & vbNewLine & _
"You have a open MCR that needs attention. " & _
vbNewLine & vbNewLine & _
" Click Here " & _
vbNewLine & vbNewLine & _
"Thank you!"
'You can add a file to the mail like this
.Display ' or use .Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Option Explicit Statement (Visual Basic)
Forces explicit declaration of all variables in a file, or allows implicit declarations of variables.

How can I refer a hyperlink to a cell value in the body of an email?

I would like to hyperlink a cell and have the value of that cell be the hyperlink in the body of the email.
So in below's code instead of "Hello" it should refer to value of a cell. Say if Range("A1") equals 100, the hyperlink in the body of the email should say 100. If I change Range("A1") to 101, the hyperlink in the email should change to 101.
Thanks for your help!
My code:
Sub SendHyperlinkEmail()
Dim outApp As Object
Dim OutMail As Object
Dim strbody As String
Set outApp = CreateObject("Outlook.Application")
Set OutMail = outApp.CreateItem(0)
strbody = "<A HREF='mailto:z#zzz.com'>Hello</A>"
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Test
.HTMLBody = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set outApp = Nothing
End Sub
I think concatenation would work.
strbody = "<A HREF='mailto:z#zzz.com'>" & range("a1") & "</A>"
"&" is used in VBA to concatenate text and variables/ranges/etc
Actually managed to get a fairly ugly solution myself so open for improvement:
Sub SendHyperlinkEmail()
Dim outApp As Object
Dim OutMail As Object
Dim strbody As String
Set outApp = CreateObject("Outlook.Application")
Set OutMail = outApp.CreateItem(0)
strbody = "<table>" & "<tr>" & "<A
HREF='mailto:mailto:z#zzz.com?subject=Enquiry&Body=I would
like to'>" _
& range("B2") & " " & range("C2") & "</A>" & "</tr>" &
_ "<tr>" & "<A HREF='mailto:mailto:z#zzz.com
subject=Enquiry&Body=I would like to'>" _
& range("B3") & " " & range("C3") & "</A>" & "</tr>" & _
"<tr>" & "<A HREF='mailto:mailto:z#zzz.com?subject=Enquiry&Body=I would like to'>" _
& range("B4") & " " & range("C4") & "</A>" & "</tr>" & _
"</table>"On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Test
.HTMLBody = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set outApp = Nothing
End Sub

Send Outlook email using text in an Excel textbox - Error 424: Object required

I am trying to send an email with Outlook using text in a textbox (I named it tx in Excel) as body.
When I run the code, there is an error on the line:
strbody = tx.Text
Error 424: Object required
Sub SendMail()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
strbody = tx.Text
'On Error Resume Next
With OutMail
.To = "..."
.CC = ""
.BCC = ""
.Subject = Cells(3, 2)
.Body = strbody
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Replace Sheet's name by the name of the sheet where your textbox is
in strbody = ThisWorkBook.Sheets("Sheet's name").Shapes("tx").ControlFormat.Value
Sub SendMail()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
strbody = ThisWorkBook.Sheets("Sheet's name").Shapes("tx").ControlFormat.Value
'On Error Resume Next
With OutMail
.To = "..."
.CC = ""
.BCC = ""
.Subject = Cells(3, 2)
.Body = strbody
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
You could use CDO? Here's some quick VBA code I put in a test function in Excel VBA (with the email addresses and SMTP server address redacted):
Sub test()
Dim strbody As String
strbody = "Test Email" & vbNewLine & vbNewLine & "TEST EMAIL"
Dim iMsg As Object
Set iMsg = CreateObject("CDO.Message")
With iMsg
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
= "whateverYourSMTPServerIs"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") _
= 25
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") _
= 2 'Stands for sending using CDO
.Configuration.Fields.Update
.To = "someemail#someplace.com"
.CC = ""
.BCC = ""
.From = "someemail#someplace.com"
.Subject = "Test Email"
.TextBody = strbody
.Send
End With
End Sub

Add attachment with varying date in file name to Outlook mail

I have an Excel file named "Home Audio for Planning (28-3-2013).
The date will change every day but the text will be the same.
How do I attach those files to Outlook?
Sub Test()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hello World!"
.Attachments.Add ("C:\Users\Desktop\Today\Home Audio for Planning (28-3-2013).xlsx")
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Try below code : strLocation will be generated dynamically. You can just pass this variable to your attachments. File name generated would be like Home Audio for Planning_28-03-2013.xlsx
Sub Test()
Dim strLocation As String
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hello World!"
strLocation = "C:\Users\Desktop\Today\Home Audio for Planning" & Format(Now(), "_DD-MM-YYYY") & ".xlsx"
.Attachments.Add (strLocation)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Easy,
.Attachments.Add ("C:\Users\Desktop\Today\Home Audio for Planning (" & FORMAT(DATE,DD-MM-YYYY)")
Did you try to change the attachemnt name dynamic. For ex;
.Attachments.Add ("C:\Users\Desktop\Today\Home Audio for Planning (" + timeVariable + ").xlsx")
and you can set the time variable before to match the date of the date in the required format.
Cheers
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strSubject As String
Dim StrSub As Integer
Dim AttachCnt As Integer
AttachCnt = Item.Attachments.Count
strSubject = Item.Subject
StrSub = Len(strSubject)
strBody = Item.Body
strBod = InStr(1, UCase(strBody), "ATTACH")
cnsolidateMsg = ""
If strBod <> 0 And AttachCnt = 0 Then
cnsolidateMsg = cnsolidateMsg & "Attachment is Null." & vbNewLine
End If
If StrSub = 0 Then
cnsolidateMsg = cnsolidateMsg & "Subject is Empty." & vbNewLine
End If
If UCase(Trim(strSubject)) = "FW:" Then
cnsolidateMsg = cnsolidateMsg & "Forward mail subject is empty." & vbNewLine
End If
If UCase(Trim(strSubject)) = "RE:" Then
cnsolidateMsg = cnsolidateMsg & "Reply mail subject is empty." & vbNewLine
End If
If cnsolidateMsg <> Empty Then
If MsgBox(cnsolidateMsg & vbNewLine & "Are you sure you want to send the Mail?", vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for send mail") = vbNo Then
Cancel = True
End If
End If
End Sub
With OutMail
.To = ""
.BodyFormat = olFormatHTML '---Default
.Attachments.Add ("C:\Users\Desktop\Test.txt")
.Display
End With
If not.BodyFormat = olFormatHTMLfile will be attached in the mail body

Resources