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
Outlook

Avatar of undefined
Last Comment
Fordraiders

8/22/2022 - Mon
Systech Admin

Could you please share the errors if any?
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
ASKER
Fordraiders

should outlook be offline ?
Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
Rgonzo1971

No

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

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
See how we're fighting big data
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
ASKER
Fordraiders

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

ASKER
Fordraiders

thanks
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.