The code - FilePath = .Cells(2, "J").Value & Cells(2, "D").Value & " - " & .Cells(2, "A").Value & ".pdf"
If FileExists(FilePath) Then
.Attachments.Add FilePath
Else
MsgBox "The file " & FilePath & " does not exist at that location."
End If
Public Function FileExists(ByVal Filename As String) As Boolean
Dim lngAttr As Long
On Error GoTo NoFile
lngAttr = GetAttr(Filename)
If (lngAttr And vbDirectory) <> vbDirectory Then
FileExists = True
End If
NoFile:
Exit Function
End Function 'No change here, just to show where we are in code
With OutMail
.To = EmailTo
.CC = CCto
.BCC = ""
.Subject = Subj
.BodyFormat = 2
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set wdRng = wdDoc.Range(0, 0)
wdRng.Text = StrBody
wdRng.collapse 0
wdRng.Paste
wdRng.collapse 0
wdRng.Text = StrBody1
'Not sure where file names are coming from...but some sort of loop here
For i = 2 To Range("MergeRecords").Rows.Count
FilePath = Range("MergeRecords").Cells(i, "I").Value & Range("MergeRecords").Cells(i, "A").Value & ".pdf"
If FileExists(FilePath) Then
.Attachments.Add FilePath
Else
MsgBox "The file " & FilePath & " does not exist at that location."
End If
Next i
.DisplayLastRow = Worksheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To LastRow
FilePath = Sheet2.Cells(i, "J").Value & Sheet2.Cells(i, "D").Value & " - " & Sheet2.Cells(i, "A").Value & ".pdf"
If FileExists(FilePath) Then
.Attachments.Add FilePath
Else
MsgBox "The file " & FilePath & " does not exist at that location."
End If
Next iSub MainMacro()
Dim c As Range
Dim rngNames As Range
Dim LastRow As Long
Application.ScreenUpdating = False
'First, get all the names
Call GetUniqueNames
With Worksheets("Unique Names")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Verify that there is as least one record. This would be in row 2
If LastRow = 1 Then
MsgBox "No values found in that date range"
Exit Sub
Else
Set rngNames = .Range("A2:A" & LastRow)
End If
End With
'If there are names, loop through them all
For Each c In rngNames
'Setup the AdvFilter
Worksheets("RAW_Data").Range("DR2").Value = c.Value
'For each name, get the records, and send the email
Call FilterData
Call Preview
Next c
Application.CutCopyMode = False
Application.ScreenUpdating = True
End SubSub MainMacro()
Dim c As Range
Dim rngNames As Range
Dim LastRow As Long
Application.ScreenUpdating = False
'IMPORTANT
'Assumes that Unique names has already been run
With Worksheets("Unique Names")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Verify that there is as least one record. This would be in row 2
If LastRow = 1 Then
MsgBox "No more values found in that date range"
Exit Sub
Else
'Changed so that it only looks at first cell
Set rngNames = .Range("A2:A" & LastRow).Cells(1)
End If
End With
'If there are names, loop through them all
For Each c In rngNames
'Setup the AdvFilter
Worksheets("RAW_Data").Range("DR2").Value = c.Value
'For each name, get the records, and send the email
Call FilterData
Call Preview
Next c
c.Delete xlShiftUp
'Remove name from list, in preparation for next name
Application.CutCopyMode = False
Application.ScreenUpdating = True
End SubSub MainMacro()
Dim c As Range
Dim rngNames As Range
Dim LastRow As Long
Application.ScreenUpdating = False
'IMPORTANT
'Assumes that Unique names has already been run
With Worksheets("Unique Names")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Verify that there is as least one record. This would be in row 2
If LastRow = 1 Then
MsgBox "No more values found in that date range"
Exit Sub
Else
'Changed so that it only looks at first cell
Set rngNames = .Range("A2:A" & LastRow).Cells(1)
End If
End With
'If there are names, loop through them all
'Setup the AdvFilter
Worksheets("RAW_Data").Range("DR2").Value = rngNames.Value
Call FilterData
Call Preview
'Remove name from list, in preparation for next name
rngNames.Delete xlShiftUp
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub