Add an Attachment to email and Copy data into Email Body

  1. charley94
    Hi All
    I am currently creating a macro to be able to add an attachment to an email and also have my summary copied into my email body but it keeps coming up with Run-time Error '1004'
    Could someone please help as i cant figure out what is causing it
    The coding that i have used is;
    Dim objOutlook As Object
    Dim objNameSpace As Object
    Dim objInbox As Object
    Dim objMailItem As Object
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNameSpace = objOutlook.GetNamespace("MAPI")
    Set objInbox = objNameSpace.Folders(1)
    Set objMailItem = objOutlook.CreateItem(0)
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next

    Set rng = Sheets("Summary").Range("A1:O45").SpecialCells(xlCellTypeVisible)

    On Error GoTo 0

    If rng Is Nothing Then
    MsgBox "The selection is not a range or the sheet is protected" & _
    vbNewLine & "please correct and try again.", vbOKOnly
    Exit Sub
    End If
  2. charley94
    More coding

    With Worksheets("Summary")
    strTo = strTo & .Cells(i, 1).Value & "; "
    i = i + 1
    Loop Until IsEmpty(.Cells(i, 1))
    End With

    With Application

    .EnableEvents = False
    .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strTo = Mid(strTo, 1, Len(strTo) - 2)

    With objMailItem
    .to = ""
    .CC = ""
    .Subject = "Example attachment to multiple recipients"
    .Attachments.Add ActiveWorkbook.FullName
    .HTMLBody = rangetoHTML(rng)
    .Display 'Change to Send if you want to just send it.
    End With

    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With

    Set objOutlook = Nothing
    Set objNameSpace = Nothing
    Set objInbox = Nothing
    Set objMailItem = Nothing
    Set OutMail = Nothing
    Set OutApp = Nothing

    End Sub
  3. charley94
    Sorted it

    .Attachments.Add ActiveWorkbook.FullName
Results 1 to 3 of 3

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1