i try to send an email via VBA. This email contains the path to the file. But the path is not shown as link to the folder where the file is stored. To be honest i have no idea how to solve this problem and i could not find any solutions so far.
My Code looks like this:
Private Sub CommandButton1_Click()
Dim outlookOBJ As Object
Dim mItem As Object
Set outlookOBJ = CreateObject("Outlook.Application")
Set mItem = outlookOBJ.CreateItem(olMailItem)
With mItem
.To = "Mail.Adress#test.com"
.Subject = "Test"
.Body = "Text Text Text" & ThisWorkbook.Path
ThisWorkbook.Save
.Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
.Send
End With
End Sub
I hope someone can help me that the path will be a clickable link in my email.
thanks a lot
Related
I have a workbook (located on our network) with a macro enabled so I can email exported PDF worksheets via Outlook every Friday. The exported worksheet PDF gets saved to the same location as the Workbook. Outlook then opens the FilePicker and lets me select the file that I want to attach to the email. For some reason the Filepicker is now not opening to ThisWork.path anymore; it opens to my default MyDocuments located on my native computer. The exported file still saves in the proper spot (located on the network) but the FilePicker just wont open to that location. Now, if I move this Workbook to my direct computer, the FilePicker works as it should. I have not changed anything in the VBA so I don't know why this is all the sudden not working. It worked just last week. Below is the code I believe to be relevant to the issue.
'Creates workpath string
Dim mypath As String, fname As String
mypath = ThisWorkbook.Path
fname = CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name)
'********************************************************
'Saves PDF with Template Text and Date based on Order Date
Sheets(1).ExportAsFixedFormat 0, mypath & "\" & "TEXT Order Sheet " & Format(Range("D7").Value, "mm-dd-yy")
ActiveSheet.Name = Format(Range("D7").Value, "mm-dd-yy")
'********************************************************
Dim xStrFile As String
Dim xFilePath As String
Dim xFileDlg As FileDialog
Dim xFileDlgItem As Variant
Dim xOutApp As Outlook.Application
Dim xMailOut As Outlook.MailItem
Application.ScreenUpdating = False
Set xOutApp = CreateObject("Outlook.Application")
Set xMailOut = xOutApp.CreateItem(olMailItem)
Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
xFileDlg.Filters.Clear
xFileDlg.Filters.Add "pdf files", "*.pdf"
xFileDlg.AllowMultiSelect = True
xFileDlg.InitialFileName = ThisWorkbook.Path
If xFileDlg.Show = -1 Then
'********************************************************
With xMailOut
.Display
.To = "fake#email.com"
.Subject = "TEXT" & Range("D7").Value
.HTMLBody = "<p style='font-family:calibri;font-size:12.0pt'>" & "Here is our TEXT order for the week of " & Range("D7").Value & "." & " Please respond to this email to confirm that you have received the order." & .HTMLBody
For Each xFileDlgItem In xFileDlg.SelectedItems
.Attachments.Add xFileDlgItem
Next xFileDlgItem
.Display
End With
End If
Set xMailOut = Nothing
Set xOutApp = Nothing
Application.ScreenUpdating = True
'********************************************************
I have a master sheet and a code to split it into separate sheet based on reviewer names, now i need to send all the splitted sheet to each of the reviewers based on sheet names, example: sheet named raj must be sent to raj#gmail.com, sheet named ravi must be sent to ravi#gmail.com I managed to find a code to send a single sheet via mail, i need help to send all the sheets to respective persons via outlook.
Attaching the code to send a single sheet.
Sub EmailWithOutlook()
Dim oApp As Object
Dim oMail As Object
Dim WB As Workbook
Dim FileName As String
Dim wSht As Worksheet
Dim ShtName As String
Dim CurrDate As String
CurrDate = format(Date, "MM-DD-YY")
Application.ScreenUpdating = False
' Make a copy of the active worksheet
' and save it to a temporary file
Sheets("raj").Activate
ActiveSheet.Copy
Set WB = ActiveWorkbook
FileName = WB.Worksheets(1).Name & " " & CurrDate
On Error Resume Next
Kill "C:\Users\Desktop\workfiles\" & FileName
On Error GoTo 0
WB.SaveAs FileName:="C:\Users\Desktop\workfiles\" & FileName
'Create and show the Outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
'Uncomment the line below to hard code a recipient
.To = "raj#gmail.com"
'Uncomment the line below to hard code a subject
.Subject = "Subject Line"
'Uncomment the lines below to hard code a body
.body = "Hi Raj" & vbCrLf & vbCrLf & _
"Please find the attached file for work"
.Attachments.Add WB.FullName
.Display
End With
'Delete the temporary file
'WB.ChangeFileAccess Mode:=xlReadOnly
'Kill WB.FullName
'WB.Close SaveChanges:=False
'Restore screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub
You can iterate over all worksheets in the workbook in the following way to compose an email for each recipient individually:
Set oApp = CreateObject("Outlook.Application")
For i = 1 To WB.Sheets.Count
Set oMail = oApp.CreateItem(0)
With oMail
.To = WB.Sheets(i).Name & "#gmail.com"
.Subject = "Subject Line"
'Uncomment the lines below to hard code a body
.body = "Hi Raj" & vbCrLf & vbCrLf & _
"Please find the attached file for work"
.Attachments.Add WB.FullName
.Send
End With
Next i
You can read more about that in the following articles that I wrote for the technical blog:
How To: Create and send an Outlook message programmatically
How To: Fill TO,CC and BCC fields in Outlook programmatically
How to create and show a new Outlook mail item programmatically: C#, VB.NET
I have a mail service who is good and i want to put my active workbook on my mail but not on xlsm, i want on xlsx.
I tried a solution but the convertion don't work (error).
My code :
Private Sub CommandButton4_Click()
Dim TheMail As Variant
Dim Path_name As String
Dim File_name As String
Dim Complete_File_name As String
Set LeMail = CreateObject("Outlook.Application")
File_name = ActiveWorkbook.Name
File_name , FileFormat:=xlOpenXMLWorkbook
Path_name = ThisWorkbook.Path
Complete_File_name = Path_name & "\" & File_name
With TheMail.CreateItem(olMailItem)
.Subject = "Prerequisite"
.To = ""
.Body = ""
.Attachments.Add Complete_File_name & ".xlsx"
.Display
End With
End Sub
Thanks you for all of your response,
Have a nice day !
You cannot simple add a xlsx extension! They are two different workbooks. You should firstly save it as xlsx, to make the conversion you are talking about. Anyhow, a file having the name you try attaching does not even exist...
Please, use the next way:
Private Sub CommandButton4_Click()
Dim TheMail As Variant, Path_name As String, File_name As String
Dim Complete_File_name As String
Set TheMail = CreateObject("Outlook.Application")
File_name = ActiveWorkbook.name
Path_name = ThisWorkbook.path
Complete_File_name = Path_name & "\" & left(File_name, InStrRev(File_name, ".") - 1) & ".xlsx"
ActiveWorkbook.saveas Complete_File_name, xlWorkbookDefault
With TheMail.CreateItem(olMailItem)
.Subject = "Prerequisite"
.To = ""
.body = ""
.Attachments.Add Complete_File_name
.Display
End With
End Sub
If you do not need the 'converted' xlsx file, you can delete it. After closing, or use SaveCopyAs instead of saveAs, to not be necessary to close it.
I would like to add a .pdf file in my Outlook email, which is sent via VBA Excel.
My full Excel code looks pretty much like this:
Sub Confirmationemail()
MsgBox ("The confirmation email will be sent now")
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Dim fs As Worksheet, bs As Worksheet
Dim Filename As String, Name As String, Name2 As String, Name3 As String, Reason As String
Dim Cost As String, PathFileName As String
Dim linecount2 As Long
ChDir ThisWorkbook.Path & "\"
Set fs = Sheets("Frontsheet")
Set bs = Sheets("BoM")
linecount2 = 1
Name = fs.Range("D10")
Name2 = fs.Range("D18")
Name3 = fs.Range("D38")
If fs.Range("D38").Value = 3 Then
Reason = fs.Range("K8")
ElseIf fs.Range("D38").Value = 4 Then
Reason = fs.Range("P4")
Else
Reason = fs.Range("K4")
End If
Filename = Name & "_" & Name2
Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.BodyFormat = olFormatHTML
.Display
.HTMLBody = "The job is ready. See the PDF version in the attachment"
.To = "xxx#xxx.co.uk; yyy#yyy-is.co.uk "
PathFileName = ThisWorkbook.Path & "\" & Filename & ".pdf"
.CC = "zzz#z-is.co.uk; www#wx-c.co.uk;"
.BCC = "yxks#ug.co.uk"
.Subject = Filename & "- Audit"
'.Attachments.Add PDFFile
myattachments.Add PathFileName
'.Attachments.Add Application.ActiveWorkbook.FullName
'.Send
End With
End Sub
The best hint I found:
How to attach exported pdf file to Outlook mail using Excel VBA? but it refers to attaching the already exported PDF document. Incorporating some pieces of code was unsuccessful.
Some solution here:
Attach PDF and send email via Outlook but it refers to the specified cells only.
Other hints I found:
Excel VBA attaching print area as PDF.
Attach both pdf and excel files to an email on single click in VBA.
https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-mso_winother-mso_2010/attaching-a-pdf-file-in-vba-generated-email-in/527de6b4-66e6-4aa5-85b8-267a59ea6a7f
It’s not myattachments.Add PathFileName it should be .Attachments.Add PathFileName
See Attachments.Add method (Outlook)
Very closely related to Embed picture in outlook mail body excel vba
I'm trying to embed an image into an Outlook email.
I'm using the following code snippet, half of which has been stolen from the post above:
Sub PictureEmail()
Dim outApp As New Outlook.Application
Dim OutMail As Object
Dim Attchmnt As String
Dim Signature As String
Dim WB As Workbook
Set WB = ThisWorkbook
Attchmnt = "C:\Users\Blah\Painted_Lady_Migration.jpg"
Set OutMail = outApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = WB.Names("to").RefersToRange.Value2
.CC = WB.Names("cc").RefersToRange.Value2
.BCC = WB.Names("bcc").RefersToRange.Value2
.Subject = WB.Names("Subject").RefersToRange.Value2
.HTMLBody = "<img src=""cid:Painted_Lady_Migration.jpg""height=520 width=750>"
.display
End With
If Attchmnt = "" Then
Else
OutMail.Attachments.Add Attchmnt
End If
On Error GoTo 0
End Sub
However, when looking at the generated email, I have the error "The linked image cannot be displayed. The file may have been moved, renamed, or deleted".
I've tried a few different ways to attach the file, including:
.HTMLBody = "<img src=" & Chr(34) & "cid:Painted_Lady_Migration.jpg" & Chr(34) & "height=520 width=750>"
I just can't get it to work >_<
I saw somewhere that spaces in the name/filepath can throw it, so I replaced the spaces in the name with underscores
What dumb thing am I forgetting/missing?
The cid is created when you attach it, so you need to do that before you display/send it.
Try it like this
Set OutMail = outApp.CreateItem(0)
With OutMail
.To = WB.Names("to").RefersToRange.Value2
.CC = WB.Names("cc").RefersToRange.Value2
.BCC = WB.Names("bcc").RefersToRange.Value2
.Subject = WB.Names("Subject").RefersToRange.Value2
If Attchmnt <> "" Then
.Attachments.Add Attchmnt ' (additional arguments are optional)
.HTMLBody = "<img src=""cid:Painted_Lady_Migration.jpg"" height=520 width=750>"
Else
.HTMLBody = "[no attachment included]"
End If
.Display
End With