Hey Mike,
I don't often use Class Modules, and what I know about Outlook could fit on the back of a ****tail napkin. That said, I cleaned-up my previous suggestion a bit, and got rid of .Logon and a couple of things.
You may well get better suggestions, but in the mean time, try this one first. In short, rather than later worrying about handling a bad logon attempt, we just insist the user is already in Outlook, which as you stated, is the expected case. If this works, we can worry about if the user cancels the email (instead of hitting the Send button).
Mark
In your created Class Module named "clsOutlook":
Rich (BB code):
Option Explicit
Public WithEvents obj_OL As Outlook.Application
'
Private Sub obj_OL_ItemSend(ByVal Item As Object, Cancel As Boolean)
'// For example, change pathway to suit, such as: //
'// "\\Dacsrv02\rtddata\Advice\TechQueries\TRIM Emails" & emailname
OutMail.SaveAs ThisWorkbook.Path & _
Application.PathSeparator & _
emailname
'// AFTER the event has been called, explicitly release Outlook. //
Set obj_OL = Nothing
Set OutMail = Nothing
End Sub
In the standard module that your already had:
Rich (BB code):
Option Explicit
'// Connect the declared object w/the class module //
Dim cls_OL As New clsOutlook
'// Declare the email msg (mail item) and emailname string as Public, so //
'// that they can be "seen" from any procedures in the class mod. //
Public OutMail As Outlook.MailItem
Public emailname As String
Sub Email_Response()
Dim strbody As String
Dim emaildate As String
Dim newdate As String
'// You no doubt are using some/all of these for other code not included. //
'// I simply rem'd them to make the example easier to read. //
'Dim copymail As NewFile
'Dim Staff As String
'Dim Who As String
'Dim What As String
'Dim How_Long As String
'Dim Fortnight As Date
'Dim Name As Integer
'Dim Criteria1 As Integer
'Dim Criteria2 As Integer
'Dim Criteria3 As Integer
'Dim Criteria5 As Integer
'Dim Criteria6 As Integer
'Dim Criteria7 As Integer
'// Switch error handling to in-line for a moment. This way when we //
'// try and GetObject, if Outlook is not already running, an error will //
'// occur, which we can use to tell us what to do next. //
On Error Resume Next
'// Rather than Create the object, we'll just GetObject. While this //
'// means the user must be logged on to Outlook, this means we no longer//
'// have to worry about .Logon or what happens if the user goobers up //
'// their password. //
Set cls_OL.obj_OL = GetObject(Class:="Outlook.Application")
'// If Outlook was running, we skip by this. //
If Err.Number > 0 Then
'// If we made it here, Outlook was not running, so we want to make //
'// a graceful exit... //
On Error GoTo 0
Err.Clear
Set cls_OL.obj_OL = Nothing
MsgBox "Sorry - Outlook must be running before this program can run." _
& vbCrLf & _
"Please logon to Outlook, then (push whatever button " & _
"starts this).", _
vbCritical, ""
Exit Sub
End If
'// Since we made it past the previous test, Outlook is running, and we //
'// should reset error handling, as elsewise we may have problems //
'// in our code 'masked'. //
On Error GoTo 0
'// "timestamp" the sheet. //
ThisWorkbook.Worksheets("Technical Inquiry Form").Range("C30").Value = Now()
'// I don't see why we're disabling events, but killing .ScreenUpdating //
'// will speed up processing if there's data being written or other //
'// visible changes that would normally be painted upon execution. //
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'// Create our new mail item //
Set OutMail = cls_OL.obj_OL.CreateItem(0)
' If OptionButton1.Value = True Then
' '... strBody built here...
' End If
'// Example substitute //
strbody = "This is just example text, to substitute for the string built " & _
"from all the text boxes etc..."
On Error Resume Next
emaildate = Sheets("Technical Inquiry Form").Range("c30")
newdate = Day(Sheets("Technical Inquiry Form").Range("c30")) & "-" & _
Month(Sheets("Technical Inquiry Form").Range("c30")) & "-" & _
Year(Sheets("Technical Inquiry Form").Range("c30"))
emailname = "MRWA response to inquiry on " & "ComboBox9.Value" & _
" (Trim file " & _
Sheets("Technical Inquiry Form").Range("H22") & ") " & _
newdate & ".msg"
With OutMail
.To = TextBox6.Value
.CC = ""
.BCC = ""
.Subject = "MRWA response to your inquiry on " & "ComboBox9.Value"
.body = strbody
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
