VBA to automaticall email pdf files

[michgreen]

Hi All,

I'm 99% there on what I need to do, just need a little help with the last bit please!

Each month we create a performance report for our suppliers, titled "REPORT NAME - MONTH - SUPPLIER NAME" which is saved as .pdf and emailed out to them directly.

Using the script below I can create one report in .pdf and create the email, but I need it to repeat for about 29 more suppliers.
When I run it VBA gives me an error message which I follow and it keeps telling me it either needs "End With" or "End Sub". I type the command it's asking for but it keeps asking and doesn't stop asking for it.
Any ideas what's going on please?


Taken from this website: Automate Excel to PDF and Email PDF Document using VBA | Excel VBA Training Videos



Sub sendReminderMail()
ChDir “C:\Users\takyar\Desktop”
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
“C:\Users\takyar\Desktop\test-save.pdf”, OpenAfterPublish:=True

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object

Set OutLookApp = CreateObject(“Outlook.application”)
Set OutLookMailItem = OutLookApp.CreateItem(0)
Set myAttachments = OutLookMailItem.Attachments

With OutLookMailItem
.To = “takyar@hotmail.com”
.Subject = “Data”
.Body = “The Excel data is attached in PDF format.”
myAttachments.Add “C:\Users\takyar\Desktop\test-save.pdf”
‘.send
.Display
End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing

End Sub

 

[t3lboy]

Hello the code I have used in excel before is, I'm sure this could be easily adapted;

Sub Send_Files()
'In column A : Names of the people
'In column B : E-mail addresses
'In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)

    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 C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = cell.Value
                .Subject = "Testfile"
                .Body = "Hi " & cell.Offset(0, -1).Value

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell

                .Send  'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub