Link to home
Start Free TrialLog in
Avatar of Fordraiders
FordraidersFlag for United States of America

asked on

force items in outbox to send outlook 2010

outlook vba

Using the following code on "thisoutlooksession" on startup to force anything in "Outbox" to send.
not working ?

Dim objItem As Object 'mailitem
Dim objPage As Page
Dim colOutboxItems As Items
    On Error Resume Next
    Set colOutboxItems = Application.Session.GetDefaultFolder(olFolderOutbox).Items
  For Each objItem In colOutlboxItems
    objItem.Delete
  Next
  Set objItem = Nothing
  Set colOutboxItems = Nothing

Open in new window



Thanks
fordraiders
Avatar of Systech Admin
Systech Admin
Flag of India image

Could you please share the errors if any?
Avatar of Rgonzo1971
Rgonzo1971

Hi,

In your code you delete the items not send them

Is Outlook Offline when you open it, if so try
Sub Macro()
    Dim bOfflState As Boolean
    Dim objItem As Object 'mailitem
    Dim objPage As Page
    Dim colOutboxItems As Items

    bOfflState = Application.Session.Offline
    If bOfflState Then Application.ActiveExplorer().CommandBars.FindControl(, 5613).Execute

    On Error Resume Next
    Set colOutboxItems = Application.Session.GetDefaultFolder(olFolderOutbox).Items
    For Each objItem In colOutlboxItems
        objItem.Send
    Next
    Set objItem = Nothing
    Set colOutboxItems = Nothing
End Sub

Open in new window

Regards
Avatar of Fordraiders

ASKER

should outlook be offline ?
No

I thought if Outlook does not send the emails in the Outbox it's maybe because it's offline
ASKER CERTIFIED SOLUTION
Avatar of Systech Admin
Systech Admin
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Gaurav,

from outlook Application Startup
declared

Private Declare Sub AppSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

'Went offline first
' called my routine here
Call Something
' then went offline

Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
olApp.GetNamespace("MAPI").Folders.GetFirst.GetExplorer.CommandBars.FindControl(, 5613).Execute

Call Close_Outlook

Application.Quit
--------------------------------------------------------------------------------------------
then called the routines below:  from sue mosher(code).worked.
Sub Close_Outlook()
'this sub keeps access waiting for the outlook outbox to empty
Dim oOutApp As Object
Dim IsItSent As Integer
Dim objNameSpace As NameSpace
Dim objFolder As MAPIFolder
On Error GoTo Err_Handler
Set oOutApp = GetOutlookObject()
Set objNameSpace = oOutApp.GetNamespace("MAPI")
Set objFolder = objNameSpace.GetDefaultFolder(olFolderOutbox)
Set objRec = objNameSpace.CurrentUser

IsItSent = objFolder.Items.Count 'update the count to determine if we need to loop
If IsItSent = 0 Then
GoTo LINE10 ' do nothing
Else
'Do While IsItSent > 0
'IsItSent = objFolder.Items.Count 'update the count inside the loop
'PauseApp 1
'Loop
End If
LINE10:
Set oOutApp = Nothing
Set oMail = Nothing
Set objNameSpace = Nothing
Set objFolder = Nothing
Set objRec = Nothing
Exit_Here:
Exit Sub
Err_Handler:
sMsg = Err.Description
If sType = "Contact" Then sMsg = sMsg & " data=" & sBody
MsgBox sMsg, vbExclamation, "Error"
Resume Exit_Here
End Sub
Public Function GetOutlookObject() As Object
'this procedure attempts to set the object to existing process of outlook.application
'and if the outlook process is not running it attempts to create it.
Dim oOutApp As Object
Dim sMsg As String
' We turn Error Handling OFF so we can attempt a call and test for errors.
On Error Resume Next
' If Outlook is already open, then use GetObject to set a reference to it.
' If you know version, then comment out the unneeded calls below.
Set oOutApp = GetObject(, "Outlook.Application")
If Err.Number > 0 Then ' Outlook 97 version
Err.Clear
Set oOutApp = GetObject(, "Outlook.Application.9")
End If
If Err.Number > 0 Then ' Outlook XP version
Err.Clear
Set oOutApp = GetObject(, "Outlook.Application.10")
End If
If Err.Number > 0 Then ' Outlook 2003 version
Err.Clear
Set oOutApp = GetObject(, "Outlook.Application.11")
End If
If Err.Number > 0 Then ' Outlook 2007 version
Err.Clear
Set oOutApp = GetObject(, "Outlook.Application.12")
End If
If Err.Number > 0 Then ' Outlook 2010 version
Err.Clear
Set oOutApp = GetObject(, "Outlook.Application.14")
End If
If Err.Number Then
Err.Clear
' If code failed to "Get" an instance of Outlook, then it isn't currently
' open and we must use CreateObject to open and set a reference.
Set oOutApp = CreateObject("Outlook.Application")
' If another error has occurred, then Outlook couldn't be opened.
' Inform user and abort.
If Err.Number > 0 Then
sMsg = "Could not open Outlook. " & vbCrLf & vbCrLf & _
"Either Outlook is not installed correctly, " & vbCrLf & _
"or there is a problem with the installation. " & vbCrLf & vbCrLf & _
"Try opening Outlook before running this utility. "
MsgBox sMsg, vbCritical, "Outlook Failed to Open"
Set oOutApp = Nothing
Exit Function
End If
End If

Set GetOutlookObject = oOutApp

End Function
Public Sub PauseApp(PauseInSeconds As Long)
'for the PauseApp to work you must put this string at the top in the options compare section of the module.... Private Declare Sub AppSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
'what I like about this procedure is that it is not demanding on cpu cycles when running.
Call AppSleep(PauseInSeconds * 1000)
End Sub

Open in new window

thanks