JDW
12-14-2016, 07:47 AM
Hello,
I'm attempting to add multiple "dynamic" attachments to an outgoing e-mail using VBA. These attachments change names (dates) every week. Is there a way to add a wildcard to the file name so that it will still attach the file even if the name changes? Here is what I have so far, I can't get it to run without errors. There are three files total that I would like to attach, the names are app_opdiv_piv_<date>.xlsx, app_opdiv_nonpiv_<date>.xlsx, app_opdiv_pdf_<date>.pdf.
Sub app_opdiv_rep()
Dim wb As Workbook
Dim strFile As String, strDir As String, sendMail As String, toMail As String, ccMail As String, bccMail As String
Dim fso As Object, oFolder As Object, oFile As Object
strDir = Range("E12")
strFile = Dir(strDir & Range("G12"))
sendMail = Range("B12")
toMail = Range("H12")
ccMail = Range("I12")
bccMail = Range("J12")
Set wb = Workbooks.Open(fileName:=strDir & strFile, Local:=True)
If (sendMail = "Yes") Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder("C:\SCMS Reports\")
SearchString = "app_opdiv_"
With OutMail
.To = toMail
.CC = ccMail
.BCC = bccMail
.Subject = "App OpDiv Report"
.Body = "App OpDiv Report"
For Each oFile In oFolder.Files
If InStr(1, oFile.Name, "app_opdiv_") > 0 Then Attachments.Add oFile.Path
Next oFile
.Display
End With
End If
End Sub
I'm attempting to add multiple "dynamic" attachments to an outgoing e-mail using VBA. These attachments change names (dates) every week. Is there a way to add a wildcard to the file name so that it will still attach the file even if the name changes? Here is what I have so far, I can't get it to run without errors. There are three files total that I would like to attach, the names are app_opdiv_piv_<date>.xlsx, app_opdiv_nonpiv_<date>.xlsx, app_opdiv_pdf_<date>.pdf.
Sub app_opdiv_rep()
Dim wb As Workbook
Dim strFile As String, strDir As String, sendMail As String, toMail As String, ccMail As String, bccMail As String
Dim fso As Object, oFolder As Object, oFile As Object
strDir = Range("E12")
strFile = Dir(strDir & Range("G12"))
sendMail = Range("B12")
toMail = Range("H12")
ccMail = Range("I12")
bccMail = Range("J12")
Set wb = Workbooks.Open(fileName:=strDir & strFile, Local:=True)
If (sendMail = "Yes") Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder("C:\SCMS Reports\")
SearchString = "app_opdiv_"
With OutMail
.To = toMail
.CC = ccMail
.BCC = bccMail
.Subject = "App OpDiv Report"
.Body = "App OpDiv Report"
For Each oFile In oFolder.Files
If InStr(1, oFile.Name, "app_opdiv_") > 0 Then Attachments.Add oFile.Path
Next oFile
.Display
End With
End If
End Sub