Add attachment with varying date in file name to Outlook mail - excel

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

Related

How can I add default email signature in VBA in sending email? [duplicate]

This question already has answers here:
How to add default signature in Outlook
(15 answers)
Closed 1 year ago.
Im having a hard time on adding the default email signature when may code im using right now. it already takes me days already.
*Sub sendemail()
Application.DisplayAlerts = True
Applicatioemphasized textn.EnableEvents = True
Dim OutApp As Object
Dim OutMail As Object
Dim EmailBody As Range
Dim sentto, sentcc, subject As String
sentto = ThisWorkbook.Sheets("DISTRO").Range("B2").Value
sentcc = ThisWorkbook.Sheets("DISTRO").Range("B3").Value
subject = ThisWorkbook.Sheets("DISTRO").Range("B4").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
ThisWorkbook.Sheets("DISTO").Range("B5").Select
Set EmailBody = ThisWorkbook.Sheets("DISTRO").Range("B5").Value
EmailBody.Copy
With OutMail
.To = sentto
.CC = sentcc
.BCC = ""
.subject = subject
.Body = "Hi," & vbNewLine & vbNewLine & "As discussed please see attached file for your PMT score."
.Display
.Attachments.Add ThisWorkbook.Sheets("DISTRO").Range("B8").Value
End With
End Sub*
Give a try to below sub. The sub will display mail with default signature and you can add body message as well as attachment as per your need.
Sub SendMailWithDefaultSign()
On Error GoTo HarunErrHandler
Dim oApp As New Outlook.Application
Dim oEmail As Outlook.MailItem
Dim strAttachment As Variant, strSubject As Variant, strBody As Variant
Dim strEmail As String
Dim fileName As String
strSubject = "VBA code to send mail with default signature."
strEmail = "recipientmail#domain.com"
Set oEmail = oApp.CreateItem(olMailItem)
With oEmail
.BodyFormat = olFormatHTML
.Display
.Recipients.Add strEmail
.Subject = strSubject
.HTMLBody = "<b>Hello Everyone,</b><br>" & _
"Please cehck the attached file.<br>" & .HTMLBody
' .Attachments.Add fileName
End With
Exit Sub
HarunErrHandler:
MsgBox "Error :" & Err.Number & ", " & Err.Description, vbInformation, "Error"
End Sub

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 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

Use a named range as an email list in excel

I'm new here and just learning to code. I'm working on an Excel form and I need to use a named a range on a separate work sheet as an email list. Is there a way to add this to the .To= field?
Private Sub Email_Click()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = Range("G2") & " Shift Turnover Report is attached"
On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = Range("G2") & " Shift Turnover Report"
.Body = xMailBody
.Attachments.Add Application.ActiveWorkbook.FullName
.Send
End With
If Err Then
MsgBox "Hmmm. Something went wrong." & vbLf & "Please try again.", vbExclamation
Else
MsgBox "Your message has been sent.", vbInformation
End If
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
You may try something like this...
Dim x, Emails()
Dim strEmails As String
x = Range("EmailNamedRange").Value
Emails() = Application.Index(x, 0, 1)
strEmails = Join(Application.Transpose(Emails), ";")
With xOutMail
.To = strEmails
.CC = ""
.BCC = ""
.Subject = Range("G2") & " Shift Turnover Report"
.Body = xMailBody
.Attachments.Add Application.ActiveWorkbook.FullName
.Send
End With

VBA, Insert outlook signature in vba code

I have a vba code which sends automatically emails when a due date is approaching at least 7 seven days from the current date.
The problem is they when the email is sent without my outlook signature.
The code is:
Sub email()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To lRow
toDate = Cells(i, 3)
If toDate - Date <= 7 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
toList = Cells(i, 4) 'gets the recipient from col D
eSubject = "Doukementacion per " & Cells(i, 2) & " Targa " & Cells(i, 5)
eBody = "Pershendetje Adjona" & vbCrLf & vbCrLf & "Perfundo dokumentacionin e nevojshem per " & Cells(i, 2) & " me targa " & Cells(i, 5)
On Error Resume Next
With OutMail
.To = toList
.CC = ""
.BCC = ""
.Subject = eSubject
.Body = eBody
.bodyformat = 1
'.Display ' ********* Creates draft emails. Comment this out when you are ready
.Send '********** UN-comment this when you are ready to go live
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Cells(i, 11) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i
ActiveWorkbook.Save
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
What I found helpful was to make it a HTMLBody. so this part:
With OutMail
.To = toList
.CC = ""
.BCC = ""
.Subject = eSubject
.Body = eBody
.bodyformat = 1
'.Display ' ********* Creates draft emails. Comment this out when you are ready
.Send '********** UN-comment this when you are ready to go live
End With
would look like
With OutMail
.Display 'ads the signature
.To = toList
.Subject = eSubject
.HTMLBody = eBody & .HTMLBody
'.Display ' ********* Creates draft emails. Comment this out when you are ready
.Send '********** UN-comment this when you are ready to go live
End With
You might need to toggle events, not sure since I haven't tested with events disabled
If you don't have picture in your signature and can use .body , then you can just use this simplest tool in my opinion.
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim Outmail As Object
Set OutApp = CreateObject("Outlook.Application")
Set Outmail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Display
End With
Signature = OutMail.body
With OutMail
.Subject = "This is the Subject line"
.Body = strbody & Signature
.Send 'or use .Display
End with
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
End Sub
Have a great day

Resources