Email Attachment VBA Help!

[JamesMcEwan]

Hi all,

I have the below vba code from www.rondebruin.nl. However I would like only to have the FileCell.Value to be the filename, and have have the File Path and File Extension hard coded into the VBA as this will never change. Is there a way to do this?

Thanks for your help, here is the code:

Sub Send_Files()'Working in Excel 2000-2016
    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


                .Display  'Or use .Display / .Send
            End With


            Set OutMail = Nothing
        End If
    Next cell


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

nts = True
        .ScreenUpdating = True
    End With
End Sub

 

[wideboydixon]

Something like this?

Private Const FilePath = "C:\Users\JMcEwan\"
Private Const FileExt = ".txt"
Sub Send_Files() 'Working in Excel 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range
    Dim attachment As String

    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
                        attachment = FilePath & FileCell.Value & FileExt
                        If Dir(attachment) <> "" Then
                            .Attachments.Add attachment
                        End If
                    End If
                Next FileCell
                .Display  'Or use .Display / .Send
            End With
            Set OutMail = Nothing
        End If
    Next cell
    
    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

WBD

 

[JamesMcEwan]

This worked perfect. Thank you.