"Save As" document link won't open, with error message ".. can't find .. correct location or web address" - vba

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.

Related

Using a hyperlink to link to a document in an outlook mail

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

Is there a way to create a new Outlook email from Access 2002 without using the SendObject command?

I have a client that is using Access 2002 because it allows Replication. He is using this on Windows 10 with Outlook from Office 365.
The goal is to create a new email with all of the info filled in and attach a scanned proposal so that my client can review the email, make any changes that he wants and then send it.
In Access, the SendObject command creates and opens a plain text email and while this email is open my Outlook macro to scan a document and attach it to the email will not run.
So I would like to create a new Outlook email from Access that allows me to run my Outlook macro.
Or if I could get Access 2002 to create an email and attach the scanned document to it, I think I could get by with using msgboxes to verify specific items.
Below is the Access macro with the SendObject command followed by the Outlook macro.
Private Sub EmailProposal_Click()
'Access macro.
Dim stDocName As String
Dim stEmailAddress As String
Dim stSubject As String
Dim stMessage As String
stDocName = "rptProposal"
stEmailAddress = Forms!RequestForm!EmailAddress.Value
stSubject = "PROPOSAL"
stMessage = "Your proposal is attached." & vbCrLf & vbCrLf & "If you have any questions, please call us."
'Email the proposal.
DoCmd.SendObject acReport, stDocName, acFormatRTF, stEmailAddress, , , stSubject, stMessage
End Sub
Sub Scan()
'Outlook macro.
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
On Error Resume Next
Dim objCommonDialog As WIA.CommonDialog
Dim objImage As WIA.ImageFile
Dim strPath As String
Set objCommonDialog = New WIA.CommonDialog
'This shows the dialog box. I'd rather tell it what to do instead of having to manually choose each time.
Set objImage = objCommonDialog.ShowAcquireImage
strPath = Environ("TEMP") & "\TempScan.jpg" 'Save the scan.
If Not objImage Is Nothing Then
objImage.SaveFile strPath ' save into temp file
On Error GoTo ErrHandler
If TypeName(ActiveWindow) = "Inspector" Then
If ActiveInspector.IsWordMail And ActiveInspector.EditorType = olEditorWord Then
ActiveInspector.WordEditor.Application.Selection.Inlineshapes.AddPicture strPath 'Insert into email. I want to attach it instead.
End If
End If
Kill strPath
Else
MsgBox "The Scan macro in Outlook did not find a document." & vbCrLf & vbCrLf & _
"Please place the proposal in the printer so it can be scanned.", vbOKOnly
End If
lbl_Exit:
Set objImage = Nothing
Set objCommonDialog = Nothing
Exit Sub
ErrHandler:
Beep
Resume lbl_Exit
End Sub
It seems you just need to automate Outlook for sending out emails with the required content set up. Take a look at the following articles that give you the basics of Outlook automation:
Automating Outlook from a Visual Basic Application
Automating Outlook from Other Office Applications
Sub Send_Mail_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
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
With OutMail
.To = "eugene#astafiev.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

How to attach created .pdf to email body with VBA

I have a converted document from .docx into .pdf saved to the desktop. The last task is to attach this .pdf to the body of an e-mail; the HTML signature should remain unchanged.
I think the problem is this line of code and I don't know how to correct it:
.Attachments.Add PdfFile.FullName
The complete code:
Public Sub Mail()
Dim LastAuthor As String
LastAuthor = ActiveDocument.BuiltInDocumentProperties("last Author")
Dim Email As String
Email = Replace(LastAuthor, " ", ".") & "#xyz.ro"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Display
.Signature = "HTMLbody"
.To = Email
.CC = ""
.BCC = ""
.Subject = ActiveDocument.Name
'.Body = "AVIZAT. Multumesc mult"
'.Attachments.Add ActiveDocument.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.HTMLbody = "AVIZAT, esantionul este in ordine. Multumesc" & "<br>" & .HTMLbody
Dim objDoc As Document
Set objDoc = ActiveDocument
objDoc.ExportAsFixedFormat _
OutputFileName:=Replace(objDoc.FullName, ".docx", ".pdf"), _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, Item:=wdExportDocumentContent
' Add the attachment first for correct attachment's name with non English symbols
.Attachments.Add PdfFile.FullName
'.Preview 'Preview the email must disable .send & MsgBox (or use .Send to send it)
.send
MsgBox "E-mail trimis cu succes"
Set OutMail = Nothing
Set OutApp = Nothing
End With
End Sub
This will do:
Public Sub Mail()
Dim LastAuthor As String
Dim Email As String
Dim MyPdfName As String
Dim objDoc As Document
LastAuthor = ActiveDocument.BuiltinDocumentProperties("last Author")
Email = Replace(LastAuthor, " ", ".") & "#xyz.ro"
Set objDoc = ActiveDocument
MyPdfName = Replace(objDoc.FullName, ".docx", ".pdf")
objDoc.ExportAsFixedFormat _
OutputFileName:=MyPdfName, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, Item:=wdExportDocumentContent
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.To = Email
.CC = ""
.BCC = ""
.Subject = objDoc.Name
.HTMLBody = "<BODY style=font-size:12pt;font-family:Calibri>Servus<br>Esantionul este in ordine.<br><br>Multumesc,<br>" & .HTMLBody
.Attachments.Add MyPdfName
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "E-mail trimis cu succes"
End Sub
It's far from perfect but is a lot clearer now and most importantly, works.

Excel email reminder to outlook when excel gets updated

Ok , so, anyone know if it is possible to send an email reminder from excel to outlook automatically every time the excel sheet gets updated? If so, how that part of the macro would look like? I cant find it online anywhere.
The following code seems to work.
Right click on a worksheet and select 'View code'
and select Change event for Worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
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
With OutMail
.To = "someone#someemail.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Send Email from different email accounts

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)