VBA Sending

VBA Codes for Sending macro through outlook

Option Explicit

Public Sub ProcessFiles()
    'Setup Outlook
    Dim OutApp As Object
    Set OutApp = CreateObject("Outlook.Application")

    Dim rowCount As Integer, i As Integer
    Dim fileName As String, emailTo As String
    With Worksheets("Eamail List")
        rowCount = Application.WorksheetFunction.CountA(.Columns(1))

        For i = 2 To rowCount
            emailTo = .Cells(i, 1)
            fileName = getFileName(.Cells(i, 2))
            If Len(Dir(fileName)) Then SendMail emailTo, fileName, OutApp
        Next
    End With

    Set OutApp = Nothing
End Sub

Public Function getFileName(fileBaseName As String)
    Dim folderPath As String, fileExtension As String, fileName As String
    folderPath = Range("Settings!B1")
    fileExtension = Range("Settings!B2")

    If Left(fileExtension, 1) <> "." Then fileExtension = "." & fileExtension
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

    getFileName = folderPath & fileBaseName & fileExtension

End Function

Public Sub SendMail(emailTo As String, fileName As String, OutApp As Object)
    Dim OutMail As Object
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .to = emailTo
        .CC = ""
        .Subject = Range("Settings!B3")
        .body = Range("Settings!B4")
        .Attachments.Add fileName
        .Send
    End With
    On Error GoTo 0
    Set OutMail = Nothing
End Sub


Here is the sheet for the sending of macro.