Hi!
I'm using VBA to send out an email with an attached PDF file. Currently the setup works great, where I'm able to send an attachment to different account contacts using file locations that are in Excel columns F and G, with the inputs being in the format:
"C:\account folder\account date.pdf"
(the date is a reference to a date in a separate cell)
The problem I have is that now I'm trying to use column H to reference files with partial file names. I've tried to use wildcards like an asterisk and editing the cell to:
"C:\account folder\account date" & "*01*" & ".pdf"
The 01 here would be an account number and on these file names there could be a combination of other account numbers too, i.e. 01 + 02 or 01 + 03, but i still would want the formula to pick up this file name if it contains the 01 that occurs after the date and before .pdf.
I've tried searching for a solution and it seems I would have to use a DIR function, but I'm not sure how best to input this in my VBA or if there's a better solution.
Any suggestions?
Thanks
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the F:H column in each row
Set rng = sh.Cells(cell.Row, 1).Range("F1:H1")
If cell.Value Like "?*@?*.?*" And LCase(sh.Cells(cell.Row, 9).Value) = "yes" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = sh.Cells(cell.Row, 2).Value
.CC = sh.Cells(cell.Row, 3).Value
.Subject = sh.Cells(cell.Row, 4).Value
.Body = sh.Cells(cell.Row, 5).Value
For Each FileCell In rng.SpecialCells(xlCellTypeFormulas)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
If .Attachments.Count > 0 Then
.Send
Else
.Close 1
End If
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
Display More