I was trying to use the following code to insert a "Click here" link to link to the document that is open but I am having an issue.
When the email has been drafted and the link is inserted, only some of the hyperlink is carried over to the email, meaning that the hyperlink does not work.
I am trying the following to do this:
Private Sub Completion_Notification()
Dim xInspect As Object
Dim pageEditor As Object
Dim Strbody As String
Dim CommentsPath As String
Dim CommentsName As String
CommentsName = ActiveWorkbook.Name
CommentsPath = Application.ActiveWorkbook.FullName
Strbody = "Click Here"
'Getting the email List
Dim i As Integer
Dim Email_Rng As Range
Dim Num_of_Emails As Integer
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "Email"
.CC = ""
.Subject = "Email_Subject"
.HTMLBody = "<html><p>Hi, " & "</p>" & _
"<p>" & Strbody & _
"<p>" & "Many Thanks"
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
However, when I step into the code and check the value for the "strbody" expression the link is there in full so I have no idea why this would not be working. is there a Limit to the number of characters that can be inserted into the href?
To represent a link to a local file, Use <A HREF=""file://
Example
Option Explicit
Public Sub example()
Dim Strbody As String
Strbody = "<A HREF=""file://" & _
Application.ActiveWorkbook.FullName & _
""">Click Here</A>"
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
With OutMail
.HTMLBody = "<html><p>Hi, " & "</p>" & _
"<p>" & Strbody & _
"<p>" & "Many Thanks"
.Display
'.Send
End With
End Sub
Related
I need to attach variable PDFs from a transport folder.
Sub send_attachent()
Dim OutApp As Object
Dim OutMAil As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMAil = OutApp.CreateItem(0)
strbody = "<BODY style = font-size:12pt; font-familt:Arial>" & _
"Please find attached High Risk Defect:<br><br> AT300-HRD-00<br><br> Issue<br><br>" & _
"Regards,<br>"
On Error Resume Next
With OutMAil
.TO = "julia.naydenova#hitachirail.com"
.CC = "jean.ash#hitachirail.com"
.BCC = ""
.Subject = "AT300-HRD-00"
.Display
.HTMLBody = strbody & .HTMLBody
.Attachments.Add "I:\ServiceDelivery\MaintenanceManuals\AT300\TRANSPORT FOLDER\AT300-HRD-00031 Test.pdf"
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
End With
MsgBox "Email Sent"
On Error GoTo 0
Set OutMAil = Nothing
End Sub
I need to send variable files, so whatever I put in the folder to be attached on the email. With the file name in the macro I can only send one file.
The Outlook object model doesn't provide anything for monitoring files in a folder on the disk. You need to create a file-watcher which can monitor files in a folder and create a new mail item when a file is added to the folder. See VBA monitor folder for new files for more information on that.
Loop through files in a folder with Dir.
Option Explicit
Sub send_all_PDF_folder()
Dim outApp As Object
Dim outMail As Object
Dim strbody As String
Dim filePath As String
Dim fileName As String
Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.CreateItem(0)
strbody = "<BODY style = font-size:12pt; font-familt:Arial>" & _
"Please find attached High Risk Defect:<br><br> AT300-HRD-00<br><br> Issue<br><br>" & _
"Regards,<br>"
filePath = "I:\ServiceDelivery\MaintenanceManuals\AT300\TRANSPORT FOLDER"
With outMail
.To = "someone#somewhere.com"
.CC = "someoneCC#somewhere.com"
.Subject = "AT300-HRD-00"
.Display
.HtmlBody = strbody & .HtmlBody
fileName = dir(filePath & "\*.pdf")
Do While fileName <> ""
.Attachments.Add filePath & fileName
fileName = dir
Loop
End With
Set outMail = Nothing
Set outApp = Nothing
End Sub
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "a22550#stuart.iit.edu"
.Subject = "Report of Fixed Income" & Format(Now() - 1, "mmmm dd,yyyy")
.Body = "Dear Sir" & vbNewLine & Format(Now() - 1, "mmmm dd,yyyy") &
"Please regard the following tables:" & vbNewLine &
"Thank you!"
.Attachments.Add "C:\Users\008425\Desktop\Fixed Income--2020.05.13.xlsm
'word Editor
Dim wdDoc As Object '## Word.Document
Dim wdRange As Object '## Word.Range
Set wdDoc = objMail.GetInspector.WordEditor
wdDoc.Application.Selection.Start = Len(.Body)
I tried to Copy my excel range to Outlook mail with the my greeting description in the beginning and come next my excel copy range as a picture...After I run this syntax, my greeting skip to the end of the mail body just like signature..
Does anyone know hot to set sequences greetings→ paste charts→signatures from start to end in the outlook mail body by VBA?
[ wdDoc.Application.Selection.Start = Len(.Body)] is not right
Private Sub test()
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
Dim defSignature As String
With objMail
.Display ' Bring the signature to the body
defSignature = objMail.Body ' Save the signature
' Replace the body
.Body = "Dear Sir" & vbNewLine & Format(Now() - 1, "mmmm dd,yyyy") & _
"Please regard the following tables:" & vbNewLine & vbNewLine
'.Attachments.Add "C:\Users\008425\Desktop\Fixed Income--2020.05.13.xlsm"
'word Editor
Dim wdDoc As Object '## Word.Document
Dim wdRange As Object '## Word.Range
Set wdDoc = objMail.GetInspector.WordEditor
' Move the cursor to the end of the body
wdDoc.Application.Selection.EndKey Unit:=wdStory, Extend:=wdMove
' Insert after the cursor
wdDoc.Application.Selection.InsertAfter "This should be inserted after current body."
objMail.Body = objMail.Body & vbNewLine & "Thank you!" & defSignature
End With
End Sub
I have an Excel Document in a Template. Users input information and Save As a new genericized number. They then hit a button that auto populates an email to one of 5 people using Vlookup and based on the cost margin.
The file is Save As'd but the e-mail recipient cannot open the file, it reads invalid location. I can close and reopen the new renamed sheet and drag it into an e-mail. I need to link to the newly saved file's name that appears in the email.
Sub Email_created_Workbook()
Dim OutApp As Object
Dim OutMail As Object
Dim Mess As Object, Recip
Recip = [Sheet1!B28].Value & "; " & [Sheet1!B27].Value
Dim strbody As String
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & _
"Hello,<br><br>" & _
"There is a New PO awaiting your approval :<br><B>" & _
ActiveWorkbook.Name & "</B> is created.<br>" & _
"Click on this link to open the file : " & _
"<A HREF=""file://" & ActiveWorkbook.FullName & _
""">Link to Workbook</A>" & _
"<br><br>Regards," & _
"<br><br>Automated Approval System</font>"
On Error Resume Next
With OutMail
.To = Recip
.CC = ""
.BCC = ""
.Subject = ActiveWorkbook.Name
.HTMLBody = strbody
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Else
MsgBox "The ActiveWorkbook does not have a path, Save the file first."
End If
End Sub
The file name does adapt in my e-mail, from PO Template, but will not open.
I believe this will help you with your current issue (closing and reopening your file before sending). I've removed the the two lines of your code where you set the Outlook objects to Nothing. To reopen the current file you can use the OnTime function like so:
Sub Email_created_Workbook()
Dim OutApp As Object
Dim OutMail As Object
Dim Mess As Object, Recip
Recip = [Sheet1!B28].Value & "; " & [Sheet1!B27].Value
Dim strbody As String
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & _
"Hello,<br><br>" & _
"There is a New PO awaiting your approval :<br><B>" & _
ActiveWorkbook.Name & "</B> is created.<br>" & _
"Click on this link to open the file : " & _
"<A HREF=""file://" & ActiveWorkbook.FullName & _
""">Link to Workbook</A>" & _
"<br><br>Regards," & _
"<br><br>Automated Approval System</font>"
On Error Resume Next
With OutMail
.To = Recip
.CC = ""
.BCC = ""
.Subject = ActiveWorkbook.Name
.HTMLBody = strbody
.Display 'or use .Send
End With
Application.OnTime Now + TimeValue("00:00:10"), "SendEmail"
ThisWorkbook.Close True 'True= yes, save changes
Else
MsgBox "The ActiveWorkbook does not have a path, Save the file first."
End If
End Sub
Sub SendEmail()
Dim OutApp As Object: Set OutApp = GetObject(, "Outlook.Application") 'Grab current instance of Outlook since we already opened the instance prior to restarting Excel
Dim oInspector As OutApp.Inspector: Set oInspector = OutApp.ActiveInspector
Dim NewMail As OutApp.MailItem: Set NewMail = oInspector.CurrentItem 'Grab currently open New/Compose Mail window
NewMail.Send 'Send Email
End Sub
Let me know if this helps resolve your issue.
Using the object "Outlook.Application", I send an e-mail using VBA Access. In the body, I put a string like this:
Email = "Random things" & Chr(13) _
& "More random things" & Chr(13) _
If I show the string Email in a MsgBox it is displayed correctly, but when I send it, the linebreaks are deleted.
I've tried with:
Chr(13)
vbCrLf
vbCr
But all three have the same result:
Try This:
Sub OutlookEmail()
Dim AppOutlook As Outlook.Application
Set AppOutlook = CreateObject("Outlook.application")
Dim Mail As MailItem
Set Mail = AppOutlook.CreateItem(olMailItem)
Dim Email As String
Email = "Random things" & vbNewLine _
& "More random things" & vbNewLine
'Generate Email
Mail.Subject = "Test Subject"
Mail.To = "Test#test.com"
Mail.Body = Email
Mail.Display
Set Mail = Nothing
Set AppOutlook = Nothing
End Sub
Tested it my self appears to work correctly on my PC.
The code below display the email in Outlook. To send, change .Display to .Send
Sub SendDisplayEmail(strEmailFrom As String, strEmailTo As String, strEmailCC As String, strEmailBCC As String, strSubject As String)
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0) ' olMailItem
Debug.Print ("From: " & strEmailFrom & ", To: " & strEmailTo & ", cc: " & strEmailCC & ", bcc: " & strEmailBCC & ", file: " & xFile)
On Error Resume Next
OutMail
With OutMail
.to = strEmailTo
.CC = strEmailCC
.BCC = strEmailBCC
.Subject = strSubject
'.Body = "Random things" _
' & vbCrLf & vbCrLf & "More random things." _
.BodyFormat = 2 ' olFormatHTML
.HTMLBody = "<html>Random things<br>More random things.</html>"
'.Body = strBody
'.Save
.Display
'.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
You can use the HTMLBody (with .BodyFormat = 2) for a nice formated e-mail or .Body for the plain text e-mail. Note that %0D%0A and dont work in HTMLBody because Outlook parse it.
When I send emails they go out from my personal inbox at work, but I need them to go out from another mailbox that I have access to. I have both mailboxes in my outlook.
Can I send emails from a specific mailbox?
Here is the code I am using. It does not find the 2nd item in my account.
Sub Mail_small_Text_Change_Account()
Dim cel As Range
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 = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
On Error Resume Next
For Each cel In Range(("C2"), Range("C2").End(xlDown))
With OutMail
.To = cel.Value
'.CC = cel.Offset(0, 3).Value
.Subject = "Benefits Refund"
.Body = strbody
.SendUsingAccount = OutApp.Session.Accounts.Item(2)
.Send 'or use .Display
End With
Next
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Yes. Using a POP mail box, you can specify the user name and password for any account.
.To = "E#E.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "This is the body"
.SendUsingAccount = OutApp.Session.Accounts.Item(1)