Quantcast
Channel: Active questions tagged email - Stack Overflow
Viewing all articles
Browse latest Browse all 29925

VBA continues to run, I have to press "esc" to end the code

$
0
0

'Just trying to find a way to clean the code up so I dont have to press esc eveytime.

Sub Email_From_Excel_Basic()

Dim emailApplication As Object
Dim emailItem As Object
Dim mymsg As String
Dim cell As Range

Application.ScreenUpdating = False
Set emailApplication = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Worksheets("owssvr").Columns("S").Cells
    Set emailItem = emailApplication.CreateItem(0)

'They say the error is found in these two lines below. The (IF and Cells)

    If cell.Value Like "?*@?*.?*" And _
    Cells(cell.Row, "T") = "Yes" Then

'The next part below should be fine.

        With emailItem

        .To = Cells(cell.Row, "R").Value & ";"& Cells(cell.Row, "S").Value
        .CC = Cells(cell.Row, "S").Value & ";"& Cells(cell.Row, "S").Value & ";"& Cells(cell.Row, "S").Value

        .Subject = "Status update on your recent order"

        mymsg = "Dear "& Cells(cell.Row, "A").Value & " team,"& vbNewLine & vbNewLine
        Dim stts As String
        If Cells(cell.Row, 4).Value = "1. New Order" Then
            stts = "Your order has been received and will be processed."
        ElseIf Cells(cell.Row, 4).Value = "2. Shipped" Then
            stts = "Your order has been shipped"
        ElseIf Cells(cell.Row, 4).Value = "3. In-Process" Then
            stts = "Your order has been received. We are waiting on information to confirm your order."
        ElseIf Cells(cell.Row, 4).Value = "5. Approved" Then
            stts = "Your order is approved to ship."
        Else
        End If

        mymsg = mymsg & "Status: "& stts & vbNewLine
        mymsg = mymsg & "Expected delivery: "& Cells(cell.Row, "AF").Value & vbNewLine & vbNewLine
        mymsg = mymsg & "Project contact: "& Cells(cell.Row, "Z").Value & vbNewLine
        mymsg = mymsg & "Email: "& Cells(cell.Row, "AA").Value & vbNewLine
        mymsg = mymsg & "Phone: "& Cells(cell.Row, "AB").Value & vbNewLine & vbNewLine
        mymsg = mymsg & "*This is only an estimate. Please reach out to your project contact for further information."& vbNewLine & vbNewLine
        mymsg = mymsg & "Best regards"& vbNewLine & vbNewLine
        .Body = mymsg
        .Send

'Could the cleanup be the issue?

        End With
    Set emailItem = Nothing
    End If
Next cell

cleanup:
Set emailApplication = Nothing
Application.ScreenUpdating = True
End Sub

Viewing all articles
Browse latest Browse all 29925

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>