+ Reply to Thread
Results 1 to 4 of 4

Code to send an e-mail. Don't send if attachment not found

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    09-05-2007
    Posts
    148

    Code to send an e-mail. Don't send if attachment not found

    I found some code on the internet which e-mails some stuff based on what you have in cells.
    It works really well and attaches a file based on the file path and name being in a cell.

    One thing I want to change is that if the file is not found, don't send the e-mai and give me an error message. Better yet, ask me if I still want to send the e-mail.

    Right now if I type the file path and name, but i type something wrong, it sends the e-mail but with no attachement.

    Here's the code.


    Thanks

        Dim OutApp As Object
        Dim OutMail As Object
        Dim ws As Worksheet
    
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
    
        Set OutApp = CreateObject("Outlook.Application")
    
        For Each ws In ActiveWorkbook.Worksheets
            If ws.Range("B9").Value Like "?*@?*.?*" Then
                Set OutMail = OutApp.CreateItem(0)
    
                On Error Resume Next
                With OutMail
                    .To = ws.Range("B9").Value
                    .CC = ws.Range("C9").Value
                    .BCC = ""
                    .Subject = ws.Range("D9").Value
                    .HTMLBody = RangetoHTML(Sheets("Body").Range("A5:A19"))
                    'You can add a file like this
                    .Attachments.Add ws.Range("F9").Value
                    .Send    'or use .Display
                End With
                On Error GoTo 0
    
                Set OutMail = Nothing
            End If
        Next ws
    
        Set OutApp = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With

  2. #2
    Forum Contributor
    Join Date
    09-05-2007
    Posts
    148

    Re: Code to send an e-mail. Don't send if attachment not found

    Any ideas?

  3. #3
    Forum Contributor
    Join Date
    09-05-2007
    Posts
    148

    Re: Code to send an e-mail. Don't send if attachment not found

    Last bump. ANyone got any ideas?

  4. #4
    Valued Forum Contributor
    Join Date
    05-21-2009
    Location
    Great Britain
    MS-Off Ver
    Excel 2003
    Posts
    550

    Re: Code to send an e-mail. Don't send if attachment not found

    Try this:
    Option Explicit
    
    Sub Send_Email()
    
        Dim OutApp As Object
        Dim OutMail As Object
        Dim ws As Worksheet
        Dim fileName As String, response As Integer
    
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
    
        Set OutApp = CreateObject("Outlook.Application")
    
        For Each ws In ActiveWorkbook.Worksheets
            If ws.Range("B9").Value Like "?*@?*.?*" Then
                fileName = ws.Range("F9").Value
                Set OutMail = OutApp.CreateItem(0)
                
                'On Error Resume Next
                With OutMail
                    .To = ws.Range("B9").Value
                    .CC = ws.Range("C9").Value
                    .BCC = ""
                    .Subject = ws.Range("D9").Value
                    .HTMLBody = RangetoHTML(Sheets("Body").Range("A5:A19"))
                    
                    If Dir(fileName) <> "" Then
                        .Attachments.Add fileName
                        .send
                    Else
                        response = MsgBox("File " & fileName & " not found." & String(2, vbCrLf) & _
                            "Do you want to send this email?", vbYesNo)
                        If response = vbYes Then .send
                    End If
                
                End With
                'On Error GoTo 0
    
                Set OutMail = Nothing
            End If
        Next ws
    
        Set OutApp = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        
    End Sub
    
    
    Function RangetoHTML(rng As Range)
    ' Changed by Ron de Bruin 28-Oct-2006
    ' Working in Office 2000-2010
        Dim fso As Object
        Dim ts As Object
        Dim TempFile As String
        Dim TempWB As Workbook
     
        TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
     
        'Copy the range and create a new workbook to past the data in
        rng.Copy
        Set TempWB = Workbooks.Add(1)
        With TempWB.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial xlPasteValues, , False, False
            .Cells(1).PasteSpecial xlPasteFormats, , False, False
            .Cells(1).Select
            Application.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            On Error GoTo 0
        End With
     
        'Publish the sheet to a htm file
        With TempWB.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             fileName:=TempFile, _
             Sheet:=TempWB.Sheets(1).Name, _
             Source:=TempWB.Sheets(1).UsedRange.Address, _
             HtmlType:=xlHtmlStatic)
            .Publish (True)
        End With
     
        'Read all data from the htm file into RangetoHTML
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
        RangetoHTML = ts.ReadAll
        ts.Close
        RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                              "align=left x:publishsource=")
     
        'Close TempWB
        TempWB.Close savechanges:=False
     
        'Delete the htm file we used in this function
        Kill TempFile
     
        Set ts = Nothing
        Set fso = Nothing
        Set TempWB = Nothing
    End Function
    I've included the complete code to reproduce your requirement. I wondered why you are using On Error Resume Next, as this shouldn't be necessary in this code. Therefore I've commented out that line and the On Error GoTo 0 statement.
    Post responsibly. Search for excelforum.com

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1