Results 1 to 10 of 10
  1. #1
    Lounger
    Join Date
    Nov 2013
    Posts
    40
    Thanks
    3
    Thanked 0 Times in 0 Posts

    Display only one record before sending email

    Hello,

    I send email successfully from the macro but before sending email address with multiple rows in Column G. I need to check a single email in Outlook window for Subject Line, Contents & attachment are proper or not. I know .Display if used with Run F5 can do but i don't want my users to see the macro or Run F5.
    For testing/Display of single record from excel worksheet howto do that?.

    Thanks in advance.

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    Carmine,

    I would use a textbox to suspend the code instead of halting the code. Run your code to build an email, then use .Display command to display it followed by the following code to pop up a message box to let the user determine the next action:

    Code:
    Public Mysub()
    '
    '****CODE THAT BUILDS THE EMAIL GOES HERE****
    '
    Dim Msg As String
    Msg = "Is the email correct?"
    Response = MsgBox(Msg, vbYesNo + vbExclamation + vbDefaultButton2, "Validate Email")
    If Response = vbYes Then
        'CODE THAT CONTINUES TO SEND EMAIL
    Else
        'CODE PERFORMS ACTION IF EMAIL IS NOT CORRECT
    End If
    If the user selects "Yes" (meaning it is correct) then the code goes ahead to build and send the rest of the email. If the user selects no, it runs whatever code you create to handle the next action. With this method, there is no break in the code, the user does not see the code, nor does the user have to restart the code.

    HTH,
    Maud

  3. #3
    Lounger
    Join Date
    Nov 2013
    Posts
    40
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Hello,

    Thanks Maudibe for reply, sorry the codes are not working for me. The codes which i use for sending the email are as follows. Please suggest.
    Sub Send_Files()
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range
    Dim strReportBody As String
    Dim strReportBody1 As String
    Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim strSig As String
    Dim pthSig As String
    pthSig = "C:\Dclaim\disclaimer.htm"
    strSig = FSO.OpenTextFile(pthSig).ReadAll

    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With

    Set sh = Sheets("email")

    Set OutApp = CreateObject("Outlook.Application")
    For Each cell In sh.Columns("G").Cells.SpecialCells(xlCellTypeConst ants)

    Set rng = sh.Cells(cell.Row, 1).Range("K1:Z1")

    If cell.Value Like "?*@?*.?*" And _
    LCase(Cells(cell.Row, "H").Value) = "yes" _
    And LCase(Cells(cell.Row, "I").Value) <> "send" And _
    Application.WorksheetFunction.CountA(rng) > 0 Then

    Set OutMail = OutApp.CreateItem(olMailItem)

    strReportBody = "<H2><i>Dear Members," & "<br><br></i></H2>" & _
    "<H3>Folio No : " & cell.Offset(0, 3).Text & "<br><br></H3>" & _
    "<H3>Name : " & cell.Offset(0, -5).Text & "<br><br></H3></br>"

    On Error Resume Next

    With OutMail
    .To = cell.Value
    .Subject = Worksheets("email").Range("A2").Value
    .HTMLBody = strReportBody & strSig

    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
    '.Display 'Or use Send
    Application.Wait (Now + TimeValue("0:00:02"))
    End With

    On Error GoTo 0
    Cells(cell.Row, "I").Value = "send"
    Set OutMail = Nothing
    End If
    Next cell
    cleanup:
    Set OutApp = Nothing
    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With
    End Sub

  4. #4
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,180
    Thanks
    47
    Thanked 983 Times in 913 Posts
    You need to move Send and Display outside the With, ask the user (OutMail.Display), then send (OutMail.Send).

    cheers, Paul

  5. #5
    Lounger
    Join Date
    Nov 2013
    Posts
    40
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Hello,

    Maudibe, waiting for your support.

  6. #6
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,180
    Thanks
    47
    Thanked 983 Times in 913 Posts
    You need to tell us what doesn't work and why the suggestion above isn't suitable.

    cheers, Paul

  7. #7
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    Carmine,

    Provided your code works properly, here is the message box code inserted to ask whether the email is correctly formatted. If correct, it will run the rest of your code and send all the emails. If the format is not correct, you will be informed that the user selected No, to make the proper adjustments and try again. The added lines are in blue.

    HTH,
    Maud

    Code:
    Sub Send_Files()
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range
    Dim strReportBody As String
    Dim strReportBody1 As String
    Dim FSO As Object: Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim strSig As String
    Dim pthSig As String
    Dim Msg1 As String, Msg2 As String
    Dim Validate As Integer
    Dim response As String
    pthSig = "C:\Dclaim\disclaimer.htm"
    strSig = FSO.OpenTextFile(pthSig).ReadAll
    Validate = 0
    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With
    
    Set sh = Sheets("email")
    
    Set OutApp = CreateObject("Outlook.Application")
    For Each cell In sh.Columns("G").Cells.SpecialCells(xlCellTypeConstants)
    
       Set rng = sh.Cells(cell.Row, 1).Range("K1:Z1")
    
       If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "H").Value) = "yes" _
           And LCase(Cells(cell.Row, "I").Value) <> "send" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
    
            Set OutMail = OutApp.CreateItem(olMailItem)
            
            strReportBody = "<H2><i>Dear Members," & "<br><br></i></H2>" & _
            "<H3>Folio No : " & cell.Offset(0, 3).Text & "<br><br></H3>" & _
            "<H3>Name : " & cell.Offset(0, -5).Text & "<br><br></H3></br>"
            
             On Error Resume Next
            
             With OutMail
                .To = cell.Value
                .Subject = Worksheets("email").Range("A2").Value
                .HTMLBody = strReportBody & strSig
           
                 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
    '---------------------------------------
    'INSERTED CODE
                If Validate = 1 Then GoTo continue
            
                Msg1 = "Is the email correct?"
                Msg2 = "You have indicated that the email is not correct.  Make the proper adjustments then try again."
                response = MsgBox(Msg, vbYesNo + vbExclamation + vbDefaultButton2, "Validate Email")
                If response = vbYes Then
                   .Send
                   '.Display 'Or use Send
                   Validate = 1
                Else:
                   MsgBox Msg2
                   Exit Sub
                End If
    continue:
    '---------------------------------------
            
                Application.Wait (Now + TimeValue("0:00:02"))
            End With
           
            On Error GoTo 0
            Cells(cell.Row, "I").Value = "send"
            Set OutMail = Nothing
        End If
    Next cell
    cleanup:
    Set OutApp = Nothing
    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With
    End Sub

  8. #8
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    Carmine,

    Without a sample of your workbook, please note that the added code above is not tested but should work providing the code you posted is sound.

    Maud

  9. #9
    Lounger
    Join Date
    Nov 2013
    Posts
    40
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Thanks Maudibe for helping.

    The codes pop up the message box, is there any way to see the outlook compose window once and then proceed.
    Thanks.

  10. #10
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,634
    Thanks
    115
    Thanked 649 Times in 592 Posts
    Carmine

    Add the .Display command after your line of code:

    Next FileCell

    Code:
             With OutMail
                .To = cell.Value
                .Subject = Worksheets("email").Range("A2").Value
                .HTMLBody = strReportBody & strSig
           
                 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
    '---------------------------------------
    'INSERTED CODE
    HTH,
    Maud

  11. The Following User Says Thank You to Maudibe For This Useful Post:

    carmine (2015-10-13)

Posting Permissions

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