On Error VBA Outlook

Thanks for all your help anyway. (-:
 
Dim myOlApp As Outlook.Application
Dim myitem As Outlook.MailItem
Dim n As Integer
Dim sUsername As String

sUsername = Environ$("username") Dim filesPath AsString Set myOlApp = CreateObject("Outlook.Application")
filesPath = Environ$("USERPROFILE") Set myitem = myOlApp. CreateItem(olMailItem)
'CreateItemFromTemplate("Template.msg")

With myitem

For n = 0 To Me.EmailList.ListCount - 1 .Attachments.Add (Me.EmailList.ItemData(n))
Next n



.Subject= Nz("")
End With
myitem.To = Nz(Me.txtCustomerEmailAddress1) myitem.Display
 
Thanks for the post zpy2, not sure what your post is suggesting??
 
CreateItem(olMailItem)

End with

I just added two lines of codes.
have you tried all suggestion provided by others and me?
 
I've got some code i use that does exactly that, checks if Outlook is open, if it is do nothing, if its not then open it.

I will dig it out in the morning when in the office and post it up for you, solved a problem I was having causing a crash if outlook wasn't open when the system tried to send an email.
 
I have the following sat in it's own module.


Code:
Option Compare Database

#Const LateBind = True
Const olMinimized As Long = 1
Const olMaximized As Long = 2
Const olFolderInbox As Long = 6
#If LateBind Then
Public Function OutlookApp( _
    Optional WindowState As Long = olMinimized, _
    Optional ReleaseIt As Boolean = False _
    ) As Object
    Static o As Object
#Else
Public Function OutlookApp( _
    Optional WindowState As Outlook.OlWindowState = olMinimized, _
    Optional ReleaseIt As Boolean _
) As Outlook.Application
    Static o As Outlook.Application
#End If
On Error GoTo ErrHandler
 
    Select Case True
        Case o Is Nothing, Len(o.Name) = 0
            Set o = GetObject(, "Outlook.Application")
            If o.Explorers.Count = 0 Then
InitOutlook:
                'Open inbox to prevent errors with security prompts
                o.Session.GetDefaultFolder(olFolderInbox).Display
                o.ActiveExplorer.WindowState = WindowState
            End If
        Case ReleaseIt
            Set o = Nothing
    End Select
    Set OutlookApp = o
 
ExitProc:
    Exit Function
ErrHandler:
    Select Case Err.Number
        Case -2147352567
            'User cancelled setup, silently exit
            Set o = Nothing
        Case 429, 462
            Set o = GetOutlookApp()
            If o Is Nothing Then
                Err.Raise 429, "OutlookApp", "Outlook Application does not appear to be installed."
            Else
                Resume InitOutlook
            End If
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Unexpected error"
    End Select
    Resume ExitProc
    Resume
End Function
#If LateBind Then
Private Function GetOutlookApp() As Object
#Else
Private Function GetOutlookApp() As Outlook.Application
#End If
On Error GoTo ErrHandler
    
    Set GetOutlookApp = CreateObject("Outlook.Application")
    
ExitProc:
    Exit Function
ErrHandler:
    Select Case Err.Number
        Case Else
            'Do not raise any errors
            Set GetOutlookApp = Nothing
    End Select
    Resume ExitProc
    Resume
End Function
Sub OpenOutLook()
    Dim OutApp  As Object
    Set OutApp = OutlookApp(olMaximized)
    'Automate OutApp as desired
End Sub


Then before I start referencing Outlook, I have the following lines of code. If Outlook isn't open it opens it, if it is, it does nothing.


Code:
Dim oOutlook As Object
On Error Resume Next
    Set oOutlook = GetObject(, "outlook.application")
On Error GoTo 0
If oOutlook Is Nothing Then
    Call OpenOutLook
End If


HTH
 

Users who are viewing this thread

Back
Top Bottom