I'd like to create an email with an attachment where there is a date in the name of the file.
I'd be composing this email generally Monday for a file name that's dated for the previous Friday.
File name to be attached: 20210205 - XYZ.pdf
Here's the code I have so far:
Sub WMSCL()
LastFridayDate = Date - Weekday(Date, vbSaturday)
Dim oMsg As Outlook.MailItem
Set oMsg = Application.CreateItem(olMailItem)
With oMsg
.To =
.CC =
.Subject =
.Attachments.Add "C:\filepath\LastFriday & "- XYZ.pdf"
.HTMLBody =
.Display
End With
End Sub
Looks like you just needed to format the date so it is in the correct date format as your file path and concatenate the date to the file path correctly.
Sub WMSCL()
Dim lastFridayDate As Variant
Dim filePath As String
Dim oMsg As Outlook.MailItem
Set oMsg = Application.CreateItem(olMailItem)
lastFridayDate = Date - Weekday(Date, vbSaturday)
lastFridayDate = Format(lastFridayDate, "yyyymmdd")
filePath = "C:\filepath\"
filePath = filePath & lastFridayDate & " - XYZ.pdf"
With oMsg
.To =
.CC =
.Subject =
.Attachments.Add filePath
.HTMLBody =
.Display
End With
'Cleanup
Set oMsg = Nothing
End Sub
Related
I made a VBA code that gets the last saved file in a folder and send it via Outlook, but I need to get all files from a specific date (from current day) not only the last one.
Sub SendEmail_Demo()
'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
'Specify the path to the folder
MyPath = "..................\XML\"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Get the first XML file from the folder
MyFile = Dir(MyPath & "*.xml*", Today(), vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
'Loop through each XML file in the folder
Do While Len(MyFile) > 0
'Assign the date/time of the current file to a variable
LMD = FileDateTime(MyPath & MyFile)
'If the date/time of the current file is greater than the latest
'recorded date, assign its filename and date/time to variables
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
'Get the next XML file from the folder
MyFile = Dir
Loop
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem
Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.BodyFormat = olFormatHTML
.Display
.HTMLBody = "Hi demo"
.To = "myEmial.com"
.Subject = "Test demo"
.Attachments.Add MyPath & LatestFile
.Send
End With
End Sub
Try this:
Sub SendEmail_Demo()
Dim MyPath As String
Dim MyFile As String
'Specify the path to the folder
MyPath = "..................\XML\"
'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
'Get the first XML file from the folder
MyFile = Dir(MyPath & "*.xml", vbNormal)
'If no files were found, exit the sub
If Len(MyFile) = 0 Then
MsgBox "No files were found...", vbExclamation
Exit Sub
End If
Dim filesToSend As New Collection
Dim fileFullName As Variant
Dim startOfToday As Date
startOfToday = Now() - Timer() / 86400!
'Timer() ... elapsed seconds since the start of today
'86400 ..... seconds per day
'Loop through each XML file in the folder
Do While Len(MyFile) > 0
fileFullName = MyPath & MyFile
'If the date/time of the current file is greater than
'today 00:00 then add the file to 'filesToSend collection
If FileDateTime(fileFullName) > startOfToday Then
filesToSend.Add fileFullName
End If
'Get the next XML file from the folder
MyFile = Dir
Loop
Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.Mailitem
Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.BodyFormat = olFormatHTML
.Display
.HTMLBody = "Hi demo"
.To = "myEmial.com"
.Subject = "Test demo"
'Attach all the files to one mail
For Each fileFullName In filesToSend
.Attachments.Add fileFullName
Next fileFullName
.SEND
End With
End Sub
Hi trying to add a newline between my body content after paste a table and signature,codes are below:
dim FileName As String
Dim filepath As String
Dim rng As Range
Dim OutlookApp As Object
Dim Outlookmail As Object
Dim lastrowo As Integer
Application.ScreenUpdating = False
Set OutlookApp = CreateObject("Outlook.Application")
Set Outlookmail = OutlookApp.CreateItem(0)
lastrowo = Worksheets("Price And Accrued Info").Range("K550").End(xlUp).row
Set rng = Worksheets("Price And Accrued Info").Range("K2:y" & lastrowo)
rng.Copy
Dim vInspector As Object
Set vInspector = Outlookmail.GetInspector
Dim wEditor As Object
Set wEditor = vInspector.WordEditor
With Outlookmail
.To = ""
.cc=""
.Subject = "UNCONFIRMED TRADES AS OF " & Format$(Date, "YYYY.MM.DD")
wEditor.Paragraphs(1).Range.Text = "Hi The following trades are unconfirmed trades."
wEditor.Paragraphs(2).Range.Paste
wEditor.Paragraphs(4).Range.Text = vbNewLine & "<br>"
.display
' .attachments.Add drWorkbook.FullName
' .attachments.Add crWorkbook.FullName
'
End With
Set Outlookmail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True
Try this:
With Outlookmail
.To = ""
.cc = ""
.Subject = "UNCONFIRMED TRADES AS OF " & Format$(Date, "YYYY.MM.DD")
wEditor.Paragraphs(1).Range.Text = "Hi The following trades are unconfirmed trades." _
& String(5, vbNewLine)
wEditor.Paragraphs(5).Range.Text = "This is is the last line." _
& vbNewLine & vbNewLine
wEditor.Paragraphs(3).Range.Paste
.display
End With
I have written an email program to send newest files. Is there a code to convert it to HTML. See code below
Sub SendNewestFiles()
Dim objMail As Outlook.MailItem
Dim fldName As String
Dim sName As String
fldName = "\\mgamain\DATA\General\TINA FILES\INVOICES TO EMAIL\"
i = 0
sName = Dir(fldName)
Do While Len(sName) > 0
Set objMail = Application.CreateItem(olMailItem)
With objMail
.Subject = "MGA INTERNATIONAL INVOICES"
.BodyFormat = olFormatPlain
.Attachments.Add (fldName & sName)
.Display ' .send
End With
sName = Dir
i = i + 1
Loop
End Sub
Bodyformat should be olFormatHTML if you're wanting a html body.
The options are:
olFormatHTML,
olFormatPlain,
olFormatRichText,
olFormatUnspecified
https://learn.microsoft.com/en-us/previous-versions/office/developer/office-2003/aa211430(v%3Doffice.11)
Argh, Object doesn't support this property or method error 438!
I haven't tried this but, I think it might work:
objFS.System.IO.Path.GetFileName(fileName)
if objFS.System.IO.Path.GetFileName(fileName) = "VS12_WID1" Then
fileName = AFile.Name
getFileName = filePath & "/" & fileName
I should simplfy it more then try to rename the file.
Sub AddAttachment()
Dim myAttachments As Outlook.Attachments
Dim getFile, fileName, filePath As String
Set filePath = "F:\"
Set fileName = "V_W_*_*_.pdf"
Set getFile = "filePath" & "fileName"
Set MyApp = CreateObject("Outlook.Application")
Set myItem = MyApp.CreateItem(0)
Set myAttachments = myItem.Attachments
With myItem
.To = "email#mail.com"
.CC = ""
.Subject = "test"
myAttachments.Add getFile
.ReadReceiptRequested = False
.HTMLBody = "Report(s) Attached"
End With
myItem.Send
End Sub
I'm getting a compile error: Object required highlighting both Sub AddAttachment() and Set filePath. I feel so close to making this work!
UPDATED CODE:
Sub AddAttachment()
Dim myAttachments As Outlook.Attachments
Dim getFileName, fileName, filePath As String
Dim objFS: Set objFS = CreateObject("Scripting.FileSystemObject")
Set filePath = "F:\"
Set getFileName = filePath & fileName
Set MyApp = CreateObject("Outlook.Application")
Set myItem = MyApp.CreateItem(0)
Set myAttachments = myItem.Attachments
For Each fileName In filePath
If fcase(objFS.GetExtensionName(fileName)) = "VS111111_WID111A" Then
fileName = "VS111111_WID111A.pdf"
Exit For
End If
Next
With myItem
.To = "email#mail.com"
.CC = ""
.Subject = ""
myAttachments.Add getFileName
.ReadReceiptRequested = False
.HTMLBody = "Report(s) Attached"
End With
myItem.Send
End Sub
I have enough knowledge to read the script to understand what is going on. The code I made can only find a fixed file name. How can the file name be made dynamic?
Sub AddAttachment()
Dim myAttachments As Outlook.Attachments
Set MyApp = CreateObject("Outlook.Application")
Set myItem = MyApp.CreateItem(0)
Set myAttachments = myItem.Attachments
With myItem
.To = "email#address.com"
.CC = "email#address.com"
.Subject = ""
myAttachments.Add "F:\constantFilenameHas8char_constantFilenameHas7char_variableHas5Int_todaysModifiedDate_variableHas6Int.pdf"
.ReadReceiptRequested = False
.HTMLBody = "Report(s) Attached"
End With
myItem.Send
End Sub
Your query is not clear on how you want to get the filename.Think of using
a variable and pass the filepath and name as you required.
dim FileToAttach as string
FileToAttach ="FilePath" & "Filename"
myAttachments.Add FileToAttach
For your updated code
Sub AddAttachment()
Dim myAttachments As Outlook.Attachments
Dim getFileName, filename
Dim filePath As Object
Dim objFS As FileSystemObject
Set objFS = New FileSystemObject
Set filePath = objFS.GetFolder("C:\Users\Dinesh\Desktop\")
Set MyApp = CreateObject("Outlook.Application")
Set myItem = MyApp.CreateItem(0)
Set myAttachments = myItem.Attachments
For Each AFile In filePath.Files
Debug.Print UCase(objFS.GetExtensionName(fileName))
If UCase(objFS.GetExtensionName(AFile)) = "PDF" Then
fileName = AFile.Name
getFileName = filePath & "/" & fileName
Exit For
End If
Next
With myItem
.To = ""
.CC = ""
.Subject = ""
myAttachments.Add getFileName
.ReadReceiptRequested = False
.HTMLBody = "Report(s) Attached"
.Display
End With
'myItem.Send
End Sub
I'm writing a VBA query which automatically sends an email when you press a button in word. I would also like it to attach a certain file. Problem is however the file it needs to attach has a name which has an element in it which changes (like report+weeknr, the date part changes)
But because I also include the weeknr into the subject of the mail (like "Subject: report+weeknr") i though I could automate the attaching of the document through create a variable which is a result from report + weeknr. It does not work however. Anybody an idea how i can get this working? See code below:
Sub Sendmessage()
Dim OutApp As Object
Dim OutMail As Object
Dim var1 As String
Dim sentto As Long
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
var1 = InputBox("Insert week")
'Line below is where it goes wrong. Var2 leads to C:\Documents and Settings\aa471714\Desktop\SENS referentenrapportage - week " & var1 & ".ppt
var2 = "C:\Documents and Settings\aa471714\Desktop\SENS referentenrapportage - week " & var1 & ".ppt"
With OutMail
.To = "marcvanderpeet#gmail.com; marc#gmail.com"
.CC = ""
.BCC = ""
.Subject = "Report_" & var1
.Body = "Text"
.Attachments.Add (var2)
.Display
End With
End Sub
Sub Sendmessage()
Dim OutApp As Object
Dim OutMail As Object
Dim var1 As String
Dim sentto As Long
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
var1 = InputBox("Insert week")
'Line below is where it goes wrong. Var2 leads to C:\Documents and Settings\aa471714\Desktop\SENS referentenrapportage - week " & var1 & ".ppt
var2 = "C:\Documents and Settings\aa471714\Desktop\SENS referentenrapportage - week " & var1 & ".ppt"
With OutMail
.To = "marcvanderpeet#gmail.com; marc#gmail.com"
.CC = ""
.BCC = ""
.Subject = "Report_" & var1
.Body = "Text"
.Attachments.Add (var2)
.Display
End With
End Sub