How to open outlook to run behind my application?

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • Dean Kemp
    New Member
    • Feb 2011
    • 2

    How to open outlook to run behind my application?

    Hi
    I have designed a button that sends a mail “automated” by the system. But it doesn’t work if outlook is closed. And I have a string of code that opens outlook but then it opens on top of my app.
    Is there a way to open outlook to run behind the app.
    this is the coding so far.

    Code:
    Private Sub Command131_Click()
    
    MyAppID = Shell("C:\Program Files\Microsoft Office\OFFICE12\Outlook.exe", 1)
    
    
      On Error Resume Next
      With GetObject(, "Outlook.Application")
        .ActiveWindow.WindowState = 1   ' olMinimized = 1
      End With
    
    
    
    Dim A3 As String
    A3 = Me.Contact_Name
    
    If IsNull(A3) = True Then
    MsgBox "You dont have all the contact details saved on the page!", vbInformation, "Notification"
    End If
                   
    Dim A4 As String
    A4 = Forms!Intro!Text288
    
    Dim A5 As String
    A5 = Me.Trade_Name
    
    Dim A6 As String
    A6 = Forms!Intro!Text80
    
    Dim EMailAdd As String
                            
                          If IsNull(EMailAdd = Me.Contact_Email_Address) = True Then
                            MsgBox "You dont have all the contact details saved on the page!", vbInformation, "Notification"
                            Else
                            EMailAdd = Me.Contact_Email_Address
                            
                            Dim FilePath As String
                            'FilePath = [Forms]![E-Mail Correspondance]![FileTrigger]
                            
                            
                            Dim objApp As outlook.Application
                            Dim objOutlookMsg As outlook.MailItem
                            Dim objOutlookRecipient As outlook.Recipient
                            Dim objOutlookAttach As outlook.Attachment
                            Dim blnOutlookInitiallyOpen As Boolean
                            Dim strProcName As String
                            
                            On Error Resume Next
                            strProcName = "SendOutlookMessage"
                            
                            blnOutlookInitiallyOpen = True
                            Set objApp = GetObject(, "Outlook.Application")
                            If objApp Is Nothing Then
                                Set objApp = CreateObject("Outlook.Application")
                                '* Outlook wasn't open when this function started.
                                blnOutlookInitiallyOpen = True
                            End If
                               If Err <> 0 Then Beep: _
                                MsgBox "Error in " & strProcName & " (1): " _
                                    & Err.Number & " - " & Err.Description: _
                                Err.Clear: _
                                GoTo Exit_Section
                            
                            'Create the message
                            Set objOutlookMsg = objApp.CreateItem(olMailItem)
                            If Err <> 0 Then Beep: _
                                MsgBox "Error in " & strProcName & " (2): " _
                                    & Err.Number & " - " & Err.Description: _
                                Err.Clear: _
                                GoTo Exit_Section
                                
                            With objOutlookMsg
                                Set objOutlookRecipient = .Recipients.Add(EMailAdd)
                                objOutlookRecipient.Type = olTo
                                If strEmailCCAddress = "" Then
                                Else
                                    Set objOutlookRecipient = .Recipients.Add(strEmailCCAddress)
                                    objOutlookRecipient.Type = olCC
                                End If
                                If strEmailBccAddress = "" Then
                                Else
                                    Set objOutlookRecipient = .Recipients.Add(strEmailBccAddress)
                                    objOutlookRecipient.Type = olBCC
                                End If
                                .Subject = "Individual Batch SOR."
                                .Body = "Good day " + A3 + ". This is an automated e-mail. Please do not reply to this email ."
                                
                                        '* Add attachments
                                If Not IsMissing(A2) Then
                                    If Trim(A2) = "" Then
                                    Else
                                      Set objOutlookAttach = .Attachments.Add(A2)
                                      '  Set objOutlookAttach = .Attachments.Add("C:\MIS\Download/Prov-02.xls")
                                      '  Set objOutlookAttach = .Attachments.Add("C:\MIS\Download/Prov-03.xls")
                                      '  Set objOutlookAttach = .Attachments.Add("C:\MIS\Download/Prov-04.xls")
                                      '  Set objOutlookAttach = .Attachments.Add("C:\MIS\Download/Prov-05.xls")
                                      '  Set objOutlookAttach = .Attachments.Add("C:\MIS\Download/Prov-06.xls")
                                      '  Set objOutlookAttach = .Attachments.Add("C:\MIS\Download/Prov-07.xls")
                                      '  Set objOutlookAttach = .Attachments.Add("C:\MIS\Download/Prov-08.xls")
                                        
                                        'Set objOutlookAttach = A1
                                        If Err <> 0 Then Beep: _
                                            MsgBox "Error in " & strProcName & " (3): " _
                                                & Err.Number & " - " & Err.Description: _
                                            Err.Clear: _
                                            GoTo Exit_Section
                                    'End If
                                'End If
                            
                                If blnDisplayMessage Then
                                    .Display
                                Else
                                    '* Send message by putting it in the Outbox
                                    .Send
                                End If
                            'End With
                                
                            If Err <> 0 Then Beep: _
                                MsgBox "Error in " & strProcName & " (99): " _
                                    & Err.Number & " - " & Err.Description: _
                                Err.Clear: _
                                GoTo Exit_Section
                                
    Exit_Section:
                                On Error Resume Next
                                If Not blnOutlookInitiallyOpen Then
                                   objApp.Quit
                                End If
                                Set objApp = Nothing
                                Set objOutlookMsg = Nothing
                                Set objOutlookAttach = Nothing
                                Set objOutlookRecipient = Nothing
                                On Error GoTo 0
                  
    MsgBox "If no error was recieved your request has been sent.", vbInformation, "Notification!"
      
    
    
    End If
    End If
    End With
    End If
    End Sub
  • Dean Kemp
    New Member
    • Feb 2011
    • 2

    #2
    Ok, i have it sorted. used a yes no dialog box.
    Thanks

    Comment

    Working...