PDA

View Full Version : only run one email command and other processes based on user prompt using excel vba



cmccabe1
08-25-2016, 06:33 AM
In the VBA below if the user says yes to the prompt in 'Check' in bold, then it goes to line 5, sends only the QC email to two users (with an attachment), removes text files, calls a DB, and closes and exits. However, if the user answers no to the prompt in 'Check' in bold, then it goes to line 4, send only the standard email to 1 user, removes text files, calls a DB, and closes and exits. Basically, my question is how to I get it to only send send one email based on the user prompt? That is if the user says yes to the prompt in 'Check' in bold, then it goes to line 5, send the email to two users (with an attachment), removes text files, calls a DB, and closes exits and if the user answers no to the prompt in 'Check' in bold, then it goes to line 4, send an email to 1 user, removes text files, calls a DB, and closes and exits. Thank you :).


VBA



' CHECK '
iYesNo = MsgBox("Are any of the samples used for QC?", vbYesNoCancel)
Select Case iYesNo
Case vbYes
GoTo Line5
Case vbNo
GoTo Line4
End Select

' SEND EMAIL '
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim Outlook As Outlook.Application ' ADD MICROSOFT OUTLOOK 14.0 REFERENCE '
Dim ns As Outlook.Namespace
Dim Folder As Outlook.MAPIFolder


' CHECK AND LAUNCH OUTLOOK '
Set Outlook = CreateObject("Outlook.Application")
Set ns = Outlook.GetNamespace("MAPI")
Set Folder = ns.GetDefaultFolder(olFolderInbox)
Outlook.Explorers.Add Folder


' SEND STANDARD EMAIL '
Line4:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = "Hi ***," & vbNewLine & vbNewLine & _
"There are 4 reports ready" & vbNewLine & _
"Regards" & vbNewLine & vbNewLine & _
"***"


On Error Resume Next
With OutMail
.To = "***@***.x"
.CC = ""
.BCC = ""
.Subject = "aCGH"
.Body = strbody
'.Attachments.Add ("C:\test.txt")
.Send
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing


' SEND QC EMAIL '
Line5:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


strbody = "Hi ***," & vbNewLine & vbNewLine & _
"There are 4 reports ready with one sample used for QC, please make coipies of the reports and give them to *** with the form attached" & vbNewLine & _
"Regards" & vbNewLine & vbNewLine & _
"***"


On Error Resume Next
With OutMail
.To = "***@***.x"
.CC = "yyy@yyy.y"
.BCC = ""
.Subject = "aCGH"
.Body = strbody
.Attachments.Add ("C:\path\to\file.doc")
.Send
End With
On Error GoTo 0


Set OutMail = Nothing
Set OutApp = Nothing


'REMOVE TEXT FILES '
Dim aFile As String
aFile = "C:\aCGH\*.txt"
If Len(Dir$(aFile)) > 0 Then
Kill aFile
End If


' CALL DB
MsgBox ("Please update the array database")
Call Shell("explorer.exe" & " " & "N:\path\to\folder", vbNormalFocus)


'CLOSE AND EXIT '
Application.DisplayAlerts = False
Application.Quit

' SELECT CLOSE AND EXIT '
Case vbNo
Application.DisplayAlerts = False
Application.Quit
End Select