HTML hyperlink stops at spaces in filepath - html

When sending an email via a VBA code I have written, the filepath being sent in the body of the email stops at the first space. I believe I have the right amount of quotations around it, but its still coming up short.
Also, is anyone aware of a quick fix so that it includes the signature of the user sending the email?
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo Cleanup
For Each cell In Columns("M").Cells.SpecialCells(xlCellTypeConstants)
If LCase(Cells(cell.Row, "M").Value) = "no" Then
Set OutMail = OutApp.CreateItem(0)
strbody = "Dear " & Cells(cell.Row, "A").Value _
& "<br>" & "<br>" & _
"You still have outstanding work on the Rescan Spreadsheet " & _
" Title number: " & Cells(cell.Row, "E").Value _
& "<br>" & "<br>" _
& "Click here to open file location"
On Error Resume Next
With OutMail
.To = Cells(cell.Row, "B").Value
.CC = "Bethany.Turner#Landregistry.Gov.uk"
.Subject = "Re-Scan Reminder"
.HTMLbody = strbody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
Cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
MsgBox "Reminder Sent", vbOKOnly
End Sub
Following the display of the message, when you click the hyperlink, it stops and provides an error message saying \\cv-vfl-d01\dlr_office\Operational cannot be located.

You don't need to use ampersands between the href= and the file name, but you do need to add an extra double-quote:
"<A href=""\\cv-vfl-d01\dlr_office\Operational Teams\RR Scanning Team\" & _
"Back file QA Xerox\Document Rescans\Rescans 2019"">Click here to open file location</A>"
HTML requires the url to have quotation marks around the link. If this was a normal string in HTML it would look like:
My link name
Alternatively, you can use the Chr() function to place the double-quote character in your string if it helps you:
"<A href=" & Chr$(34) & "\\cv-vfl-d01\dlr_office\...

Related

Sending an email to a list of people from a query - Problem with loop

I have a form that shows the results of an union query that has a button with the following code. What I want the button to do is email each person on that query separately with their information. If I leave the Do Until - Loop off it creates the email perfectly. When I include the loop I get an odd message,
Run-Time error '-1834742 (ffe4010a)':
The item has been moved or deleted focused on the .bodyformat line below. I tried commenting out that line to see what happened, and the error moved to the .to line. I've looked over my Do Until Loop and checked the Microsoft page as well as a google search for that ridiculous run time error, but I'm striking out. Does anyone see what I'm missing?
Private Sub btnSend_Click()
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim strSubject As String
Dim strEmail As String
Dim strPDHSUM As String
Dim sqls As String
Dim MyDb As DAO.Database
Dim rsEmail As DAO.Recordset
Set MyDb = CurrentDb
Set rsEmail = MyDb.OpenRecordset("eqREPPDHSummaryZero")
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With rsEmail
.MoveFirst
Do Until rsEmail.EOF
strEmail = .Fields(2)
strPDHSUM = .Fields(1)
With MailOutLook
.BodyFormat = olFormatRichText
.To = strEmail
'.CC = ""
'.bcc = ""
.Subject = "PDH Summary"
.HTMLBody = "Hello!" & "<br>" & "This is an automated reminder about the Professional Development Hour requirement for PFS. Each PFS staff member is required to have 4 hours of approved professional development each year. " & "<br>" & "<br>" & "So far this year you have taken " & strPDHSUM & " PD hours." & "<br>" & "<br>" & "Additional PDH classes are held each month and can be found at the " & "<a href=https://avalidaddress.com>PDH Class Schedule on OnBase</a> " & "If you feel there is an error in this information or need assistance signing up for PDH credits, please email " & "<a href=mailto:MyEmail#whereIWork.edu>Rob Loughrey</a>." & "<Br>" & "<br>" & "Thank you," & "<br>" & "PFS Education and Quality Unit"
.Send
'.Display 'Used during testing without sending (Comment out .Send if using this line)
End With
sqls = "INSERT INTO tblEmails " _
& "(TypeofEmail, SendDateTime, EmailAddress) VALUES " _
& "('PDH Summary', Now(), '" & strEmail & "');"
DoCmd.RunSQL sqls
.MoveNext
Loop
End With
Set MyDb = Nothing
Set rsEmail = Nothing
End Sub````
Move:
Set MailOutLook = appOutLook.CreateItem(olMailItem) into recordset loop
Do Until rsEmail.EOF
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Have to create as many mail items as emails sending. When it was outside For loop, just created one mail item which only worked with first mail sent, when loop was hit a second time MailOutlook was gone so code failed.

How to remove the automatically generated lines above signature in HTML body?

When I .Display mail, to add the signature, two empty lines are added above the signature. Is there a way to remove them, to make the mail look better, without losing the signature formatting?
With objOutlookMsg
.SentOnBehalfOfName = "test#stackoverflow.com"
.To = "test#stackoverflow.com"
.CC = "test#stackoverflow.com"
.Subject = "Stackoverflow"
' Tekst
.Display
.HTMLBody = "<p style='font-family:arial;font-size:13'>" & _
"Hej" & "</p>" & _
vbNewLine & vbNewLine & _
"<p style='font-family:arial;font-size:13'>" & _
"Test Test Test Test Test Test" & "</p>" & _
.HTMLBody
.Display
End With
Picture of mail and signature to show, that there are no empty lines at the beginning.
It's been a few years since you asked this, I just struggled with the same issue, where I wanted the signature to work regardless of who is sending. I figured I would still share here in case anyone else is having similar issues.
I'm not a great coder, but I was able to piece things together through a bunch of different articles/posts to get something working, so there is likely a more efficient way to execute this.
To get the signature, it effectively displays an empty e-mail with default signature, removes the white space, saves it, and then empties and discards the e-mail before moving to the final e-mail send (on my comp just discarding left the signature at the top of the final email). The signature is attached at the end of that e-mail, .HTMLBody is used for both instances.
Here is the full code with 'default' inputs, for anyone else that may stumble across:
Sub sig_and_email_send()
Dim OutApp As Object
Dim OutMail As Object
Dim signature As String
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'gets default signature from e-mail
With OutMail
'2 = HTMLBody Format
.BodyFormat = 2
.Display
'deletes blank space present before signature
signature = Replace(OutMail.HTMLBody, "<p class=MsoNormal><o:p> </o:p></p>", "")
'removes entire e-mail contents and then closes with discard
OutMail.HTMLBody = Replace(OutMail.HTMLBody, OutMail.HTMLBody, "")
OutMail.Close 1
End With
On Error Resume Next
With OutMail
.to = "email#email.com"
.CC = "email#email.com"
.BCC = "email#email.com"
.Subject = "Subject"
.Attachments.Add "\\network\folder\documents\file.xlsx"
.HTMLBody = .HTMLBody & "Hi," & "whateveryourtextis" & _
"<br>" & "Thanks," & "<br><br>" & 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

VBA & HTMLBody - Spacing between Body and Signature

I will be using excel to send emails to my clients requesting certain files from them. I have everything working except for 1 small detail and I do not want to use this until I have that 1 detail figured out.
My email populates almost perfectly, except for the fact that at the end, there is about 3 lines of space between "Regards" and my signature. I'm not sure why this is happening. It shows up like this:
Thank you for your attention in this matter.
Regards,
Signature
Does anyone know how to fix it. My code is listed below:
Sub KYC_FATCA()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim signature As String
Dim AccOpen As String
Dim ConDoc As String
Dim SIP As String
Dim AFS As String
Dim W8 As String
Dim LEI As String
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("G").Cells.SpecialCells(xlCellTypeConstants)
'KYC Account Opening Form
If (Cells(cell.Row, "I").Value) = "No" Then
AccOpen = "<b>KYC Account Opening Form</b> ." & "<br>" & "<br>"
Else
AccOpen = ""
End If
'Constating Document
If (Cells(cell.Row, "J").Value) = "No" Then
ConDoc = "<b>Constating Document</b> - ." & "<br>" & "<br>"
Else
ConDoc = ""
End If
'Statement of Policy and Guidelines (SIP&G)
If (Cells(cell.Row, "L").Value) = "No" Then
SIP = "<b>Statement of Policy and Guidelines (SIP&G)</b> - " & "<br>" & "<br>"
Else
SIP = ""
End If
'Audited Financial Statements (AFS)
If (Cells(cell.Row, "M").Value) = "No" Then
AFS = "<b>Audited Financial Statements (AFS)</b> - ." & "<br>" & "<br>"
Else
AFS = ""
End If
'W-8BEN-E Form
If (Cells(cell.Row, "N").Value) = "No" Then
W8 = "<b>W-8BEN-E Form</b> - " & "<br>" & "<br>"
Else
W8 = ""
End If
'Legal Entity Identifier (LEI)
If (Cells(cell.Row, "O").Value) = "Needed" Then
LEI = "<b>Legal Entity Identifier (LEI)</b> - " & "<br>" & "<br>"
Else
LEI = ""
End If
If cell.Value Like "?*#?*.?*" And _
(Cells(cell.Row, "H").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
End With
signature = OutMail.HTMLbody
On Error Resume Next
With OutMail
.To = cell.Text 'Whatever is in cell G
.cc = Cells(cell.Row, "C").Value
'Testing if statements - The below one works perfect
'If LCase(Cells(cell.Row, "Z").Value) = "" Then
' .cc = Cells(cell.Row, "P").Value
'End If
.Subject = Cells(cell.Row, "A").Value & " - " & "Documentation Request" _
.HTMLbody = "<p style='font-family:calibri;font-size:11pt'>" & "Dear " & Cells(cell.Row, "D").Value & ",<br>" & "<br>" & _
"On behalf of " & Cells(cell.Row, "B").Value & ", please by " & "<b><u>" & Cells(cell.Row, "Q").Text & "</b></u>" & "." & "<br>" & "<br>" & _
AccOpen & _
ConDoc & _
SIP & _
AFS & _
W8 & _
LEI & _
"If you have any questions and/or concerns, please contract your Relationship Manager, " & Cells(cell.Row, "B").Value & "." & "<br>" & "<br>" & _
"Thank you for your attention in this matter." & "<br>" & "<br>" & _
"Regards," & "</p>" & _
signature _
'You can add files also like this
If (Cells(cell.Row, "I").Value) = "No" Then
.Attachments.Add ("C:doc")
End If
.Display 'This will open the message itself. If you'd like to send right away, use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
The problem is this line:
signature = OutMail.HTMLbody
This is a clever way to get the signature, but the default email body has a couple blank lines above the signature, and those are getting included when you concatenate the email.
I would visually check signature in a debugger and see what is in there, and remove the stuff you don't want. A simple example might be:
Function RemoveBlankStuff(ByVal text as string) as string
text = text.Replace("<P></P>","") 'Remove any empty paragraphs
text = text.Replace("<BR>","") 'Remove any line breaks
Return text;
End Function
signature = RemoveBlankStuff(OutMail.HTMLBody);
You will need to modify the above function depending on what you find in signature.
I was doing something similar and running into the same issue.
This should work if you replace this portion of code:
With OutMail
.Display
End With
signature = OutMail.HTMLbody
With the following code - it effectively opens, deletes whitespace, and deletes/discards the e-mail created to get the signature:
'gets default signature from e-mail
With OutMail
'2 = HTMLBody
.BodyFormat = 2
.Display
'deletes blank space present before signature
signature = Replace(OutMail.HTMLBody, "<p class=MsoNormal><o:p> </o:p></p>", "")
'removes entire e-mail contents and then closes with discard
OutMail.HTMLBody = Replace(OutMail.HTMLBody, OutMail.HTMLBody, "")
OutMail.Close 1
End With
Not sure if it makes a difference, but in .HTMLBody, I also start as -
.HTMLBody = .HTMLBody & "Good Afternoon," & "<br>" & "whateveryourtextis" & "Thanks," & "<br><br>" & signature

Outlook VBA variable into HTML Body

I created an Macro in MS Outlook for an email. The user inputs an answer to a question which results in a variable storing that data as a string. An email is then generated in HTML with a hyperlink containing that variable. I can't seem to figure out how to concatenate the variable "strTrackingNumber" into the complete hyperlink. Any suggestions?
Option Explicit
Sub TestFile
Dim strTrackingNumber as String
strTrackingNumber = InputBox("Please input the Tracking Number")
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
.To = "mickey.smith#surfer.com"
.CC = ""
.BCC = ""
.Subject = "Forecast"
.Categories = ""
.BodyFormat = olFormatHTML ' send HTML message
.HTMLBody = "<style> body{color:black;font-family:Arial;font-size: 12pt;}" & _
"<HTML><body>Dear Member,<br><br> The following document is ready for your review."<a href= 'http://www.bluewave.com/' & strTrackingNumber>Tracking & strTrackingNumber.</a></body>
.Display
End With
Set objMsg = Nothing
End Sub
Output link should look like this: http://www.bluewave.com/Tracking Number
e.g. http://www.bluewave.com/RA-15-30922
.HTMLBody = "<style> body{color:black;font-family:Arial;font-size: 12pt;} </style>" & _
"<HTML><body>Dear Member,<br><br> " & _
"The following document is ready for your review. " & _
"<a href= 'http://www.bluewave.com/" & strTrackingNumber & "'>Tracking " & _
strTrackingNumber & ".</a></body>"

Insert text from cell within Hyperlink in a email using VBA

I am fairly new to VBA and I am trying to understand how it really works.
So currently I have an excel sheet with items that have due dates.I was able to look online and send out emails to certain people with their respective due dates. Each email has a link to the excel file thats on a network drive.
However, now I am required to link to somewhere else where each item has a folder. The trick to this is that there is a directory where each item is placed in this directory. They are all within in 1 folder. The folders have the same name as in the text in the excel sheet.
I was wondering if there is a way to take the text from the cell respective to each item and place it in the hyperlink? So depending on the item and when its due. The hyperlink will change every time so it goes to the specific folder. Here is the example of the structure. Y:\Main Directory\Folder 1 and another one would be Y:\Main Directory\Folder 3. I placed the name of each folder next to each item within the excel sheet. Also the column with the name of each folder is in column "B". How would I go about this? Thank you! Much appreciated!
Here is the code:
Option Explicit
Public Sub CheckAndSendMail()
Dim lRow As Long
Dim lstRow As Long
Dim toDate As Date
Dim toList As String
Dim ccList As String
Dim bccList As String
Dim eSubject As String
Dim EBody As String
Dim vbCrLf As String
Dim ws As Worksheet
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Set ws = Sheets(1)
ws.Select
lstRow = WorksheetFunction.Max(3, ws.Cells(Rows.Count, "R").End(xlUp).Row)
For lRow = 3 To lstRow
toDate = CDate(Cells(lRow, "R").Value)
If Left(Cells(lRow, "R"), 4) <> "Mail" And toDate - Date <= 7 Then
vbCrLf = "<br><br>"
toList = Cells(lRow, "F") 'gets the recipient from col F
eSubject = "Text " & Cells(lRow, "C") & " is due on " & Cells(lRow, "R").Value
EBody = "<HTML><BODY>"
EBody = EBody & "Dear " & Cells(lRow, "F").Value & vbCrLf
EBody = EBody & "Text" & Cells(lRow, "C") & vbCrLf
EBody = EBody & "Text" & vbCrLf
EBody = EBody & "Link to the Document:"
EBody = EBody & "<A href='Hyperlink to Document'>Description of Document </A>" & vbCrLf
'Line below is where the hyperlink to the folder directory and the different folder names
EBody = EBody & "Text" & "<A href= 'Link to folder Directory\Variable based on text'>Description </A>"
EBody = EBody & "</BODY></HTML>"
MailData msgSubject:=eSubject, msgBody:=EBody, Sendto:=toList
'Cells(lRow, "W").Value = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column W"
End If
Next lRow
ActiveWorkbook.Save
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
Function MailData(msgSubject As String, msgBody As String, Sendto As String, _
Optional CCto As String, Optional BCCto As String, Optional fAttach As String)
Dim app As Object, Itm As Variant
Set app = CreateObject("Outlook.Application")
Set Itm = app.CreateItem(0)
With Itm
.Subject = msgSubject
.To = Sendto
If Not IsMissing(CCto) Then .Cc = CCto
If Len(Trim(BCCto)) > 0 Then
.Bcc = BCCto
End If
.HTMLBody = msgBody
.BodyFormat = 2 '1=Plain text, 2=HTML 3=RichText -- ISSUE: this does not keep HTML formatting -- converts all text
'On Error Resume Next
If Len(Trim(fAttach)) > 0 Then .Attachments.Add (fAttach) ' Must be complete path'and filename if you require an attachment to be included
'Err.Clear
'On Error GoTo 0
.Save ' This property is used when you want to saves mail to the Concept folder
.Display ' This property is used when you want to display before sending
'.Send ' This property is used if you want to send without verification
End With
Set app = Nothing
Set Itm = Nothing
End Function
"Description of Document "