Createobject outlook application ошибка

Обновлено: 04.07.2024

Dim oExcel As Object On Error Resume Next Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one Err.Clear On Error GoTo Error_Handler Set oExcel = CreateObject("excel.application") End If On Error GoTo Error_Handler

Below is my solution to this problem.

' sApp : GetObject Application to verify if it is running or not ' ' Usage: '

' sEXEName : Name of the exe to locate ' ' Usage: '

' Call GetAppExePath("msaccess.exe") ' GetAppExePath("firefox.exe") ' GetAppExePath("outlook.exe") ' ' Revision History: ' Rev Date(yyyy/mm/dd) Description ' ************************************************************************************** ' 1 2014-Oct-31 Initial Release '--------------------------------------------------------------------------------------- Function GetAppExePath(ByVal sExeName As String) As String On Error GoTo Error_Handler Dim WSHShell As Object Set WSHShell = CreateObject("Wscript.Shell") GetAppExePath = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" & sExeName & "\") Error_Handler_Exit: On Error Resume Next Set WSHShell = Nothing Exit Function Error_Handler: If Err.Number = -2147024894 Then 'Cannot locate requested exe. Else MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: GetAppExePath" & vbCrLf & _ "Error Description: " & Err.Description, _ vbCritical, "An Error has Occurred!" End If Resume Error_Handler_Exit End Function

Other Resources:

Ron de Bruin has another solution to this problem, see: Test if Outlook is open and open Outlook with VBA

Thank you for sharing this! It is an absolute godsend and worked exactly as described on my first try. I have been trying to fix this issue for quite some time and your solution is relatively straight forward and 100% pure VBA. I made a donation because this is so useful and hard to find a solution to anywhere on the web. Thank you and keep posting more stuff like this.

I tried late binding and early binding, but no luck with either.

My references were set correctly, and the Access DB would open Outlook and send an email on other Windows 7 machines.

I uninstalled and reinstalled office several times, and tried tools that claimed to completely remove office. Nothing worked. I was about to re-install Windows, but I found this article. As per your solution, adding the reference to the current Outlook path solved the issue and Access 2013 is now able to open Outook 2013 and send email.

Thank you for this solution,ive been pulling my hairs out trying to fix this error.
prior to upgrading a pc to office 2013 i had to remove office 2010 proffessional
after doing this my application would get a runtime error while calling outlook application.
early binding and lite binding didint work at all!!
So thanks .

Glad I could help. It was a problem I myself faced a while back which was infuriating and took me a little while to come up with this workaround.

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Dim lWnd As Long Dim iRet As Integer

lWnd = FindWindow("rctrl_renwnd32", oOutlook.ActiveWindow.Caption) 'rctrl_renwnd32 -> Outlook's Class Name iRet = ShowWindow(lWnd, 0) '0 = Hide

And that should do it.

I hope that helps.

While this works for me when running from a batch file, if I create a scheduled task to run the batch file, the IsAppRunning function returns false even with outlook open. Any ideas?

Thank you so much for this code. It is fantastic!

Wondering if you have had a chance to look at it in Windows 10 as like Uma it works perfectly for me in Windows 7 but not Windows 10.

That said, you are using Outlook installed locally on the PC and not through the web, right?

I did a quick test and can confirm the code works fine in Windows 10, so the question becomes what version of Outlook are you using? I tested with Windows 10 and Office 2013. Are you using the web based Outlook? Are you using Office 365? What bitness are you using (x32 or x64), remember you can automate between mixed bitnesses? If you give me more information I will try to see what is going on.

Well done and thanks for getting back to me many years after starting this thread. Great job!

I am running the code on (main machine) a Windows 10 64bit machine using Access 2003 and Outlook 2010.

I believe the issue is related to Outlook as when I run it on a Windows Server running Outlook 2003 (very old I know) it works fine.

Thank you for your help

Thanks so much. This is really life saving. I have been research for months and this is the only solution that works perfectly

Here are the references I have loaded:
Visual Basic for Applications
Microsoft Access 16.0Object Library
OLE Automation
Microsoft Outlook 16.0 Object Library
Microsoft Scripting Runtme

Dim o As Object
Dim m As Object
Dim retVal As Variant

Option Compare Database

My best advice would be to test it and see what the results are. I have had a lot of positive feedback on this approach, but as with most things in life, try it for yourself and see what happens. You have nothing to loose.

Thank you very much!! The code works perfectly!

Do you have any idea about it?

[code]
Private Sub cbSaveAsPDF_Click()
With Dialogs(wdDialogFileSaveAs)
.Format = wdFormatPDF
.Show
End With
End Sub
[/code]

[code]
Private Sub cbSubmit_Click()
End Sub
[/code]

Please advise, sir.
JD Stewart

Leave a Reply Cancel reply

If you found this site helpful, consider giving a donation to offset the costs to keeping it running and thank you.

About the Author

Homepage

Daniel Pineault is the owner of CARDA Consultants Inc.. For 10+ years, this firm has specialized mainly in the development of custom IT solutions for business ranging from databases, automated workbooks and documents, websites and web applications. A regular contributor to many forums including Experts-Exchange, UtterAccess, Microsoft Answers and Microsoft MSDN where he helps countless people with their various IT problems. Daniel has received the Microsoft MVP award yearly since 2010, is a recognized UtterAccess VIP and received numerous awards from Experts-Exchange.

Recent Posts

Categories

Archives

DevHut is provided graciously by CARDA Consultants Inc.

All code samples, downloads, links, …, everything on this site is provided ‘AS IS‘ and without any guarantees or warrantee. You assume the risks if you choose to try any of the code, samples, etc. provided on this site.

Microsoft Logo

Gray Pipe

We’re sorry. The content you requested has been removed. You’ll be auto redirected in 1 second.

This forum has migrated to Microsoft Q&A. Visit Microsoft Q&A to post new questions.

Answered by:

Question

I have the following code

Private objOutlook As Object ' Outlook.Application
Private objNS As Object 'Outlook.NameSpace
Private objFolder As Object 'Outlook.MAPIFolder
Public Event CantidadRegistros(ByVal Cantidad As Integer)
Public Event RegistrosProcesados(ByVal cantidad As Integer)
Public Event InformarAccion(ByVal Mensaje As String)
Public Sub New()
objOutlook = CreateObject("Outlook.Application") ' New Outlook.Application()
objNS = objOutlook.GetNamespace("MAPI")
'objOutlook.Session()
End Sub

Public ReadOnly Property FolderDefecto() As String
Get
'Outlook.OlDefaultFolders.olFolderContacts = 10
objFolder = objNS.GetDefaultFolder(10)
Return objFolder.Name
End Get
End Property

Public Function ObtenerListaFolder() As DataTable
Dim Result As DataTable = New System.Data.DataTable
Dim MyCol As System.Data.DataColumn

MyCol = New System.Data.DataColumn
MyCol.ColumnName = "DESCRIPCION"
MyCol.DataType = GetType(System.String)
MyCol.MaxLength = 100
Result.Columns.Add(MyCol)
Dim I As Integer = 0
For I = 1 To (objNS.Folders.Count)
objFolder = objNS.Folders(I)
GetSubFoldersDetail(objFolder, Result)

Next I
Return Result
End Function

Private Sub GetSubFoldersDetail(ByVal ObjFolder As Object, ByRef Tabla As DataTable)
Dim objFolder2, objFolder3 As Object

Our computers were upgraded to Office 2007. The following script fails to work on 2007, but works in 2003.

Look for the comment FAILS HERE

CreateObject("Outlook.Application") returns an error that the ActiveX object cannot be created:

Thanks for your help!!

Navy Firefighting Engineer

Ответы

Can you run this script on one of the systems with Outlook 2007 installed and post the exact message it prompts you with.

Knowing the error codes will help to determine the problem and resolution.

Is this still an open issue? Please advise. If there is no response within a week we will assume it is resolved and will close this post. Thanks

Все ответы

Can you run this script on one of the systems with Outlook 2007 installed and post the exact message it prompts you with.

Knowing the error codes will help to determine the problem and resolution.

Dim NS ' As NameSpace

Dim objOutlook ' As Application

' Dim objInbox As Outlook.MAPIFolder

Dim objFolder ' As Outlook.MAPIFolder

Dim Item ' As Object

Dim objItems ' As Object, MailItem but could be something else

Dim Icount ' Folder loop counter

Set NS = Nothing

set objOutlook = Nothing

strFolderName = "Public Folders/All Public Folders/USN/NAVAIR/ORLO/Functional Mailboxes/ORLO_498 MUSTER"

Const olFolderInbox = 6

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery _

("Select * From Win32_Process Where Name = 'outlook.exe'")

If colItems.Count > 0 Then wscript.echo "Outlook is running", 1

Set objOutlook = CreateObject("Outlook.Application")

Set objNamespace = objOutlook.GetNamespace("MAPI")

objNamespace.Logon "Default Outlook Profile",, False, True

Set objFolder = GetFolder(strFolderName)

wscript.echo "Using Mailbox: " & strFolderName

On Error Resume Next

wscript.echo ("LoadMailBox Messagecount=" & MessageCount), 1

wscript.echo "Loading Muster Mailbox content"

Set Item = objFolder.Items

'Set Item = objFolder.MailItems 'Outlook2007 seems to use MailItems instead of Items

On Error resume next

For Icount = 1 To MessageCount

' MessageCount comes from the count property of the folder in Outlook

wscript.echo "LoadMailBox, Icount = " & Icount & " MessageCount=" & MessageCount

wscript.echo "SentOn = " & Item(Icount).SentOn

'Outlook 2007 is having trouble with the item properties below

'Is it perhaps because the Outlook ObjectModell has changed?

wscript.echo "SenderName = " & Item(Icount).SenderName

if err.number <> 0 then

wscript.echo "Sender Name has a problem, Error Number " & err.number & " " & err.Description

wscript.echo "Subject = " & Item(Icount).Subject

wscript.echo "Body = " & Item(Icount).Body

' ******************* LOADING OF MESSAGES INTO MEMORY IS COMPLETE *****************

' This means all the messages, regardless of date

wscript.echo MessageCount & " Muster Messages found in LoadMailBox, Reading Inbox complete."

Public Function GetFolder(strFolderPath)

' folder path needs to be something like:

' "Public Folders\All Public Folders\Company\Sales"

Dim objApp ' As Outlook.Application

Dim objNS ' As Outlook.NameSpace

Dim colFolders ' As Outlook.Folders

Dim objFolder ' As Outlook.MAPIFolder

Dim arrFolders ' As String array

On Error Goto 0

'On Error Resume Next

if dbg then wscript.echo "GetFolder path = " & strFolderPath, 1

if dbg then wscript.echo "Adjusted folder path = " & strFolderPath

Set objApp = CreateObject("Outlook.Application")

' If Outlook is not installed, the folder will be nothing

If Err.number <> 0 Then

wscript.echo "Function GetFolder, CreateObject Outlook.Application"

On Error Goto 0

Set objNS = objApp.GetNamespace("MAPI")

Set objFolder = objNS.Folders.Item(arrFolders(0))

On Error Resume Next

If Not objFolder Is Nothing Then

For I = 1 To UBound(arrFolders)

Set colFolders = objFolder.Folders

Set objFolder = Nothing

Set objFolder = colFolders.Item(arrFolders(I))

If Err.Number <> 0 then

Msgbox "It appears that you do not have access permissions to the Muster Mailbox, call the Mailbox Owner"

if dbg then wscript.echo "Folder = " &objFolder, 1

If objFolder Is Nothing Then

Set GetFolder = objFolder

'If Dbg Then MsgBox("Getfolder is returning " & GetFolder)

On Error Resume Next

Set colFolders = Nothing

Set objNS = Nothing

Set objApp = Nothing

On Error Goto 0

Outlook is running

Using Mailbox: Public Folders\All Public Folders\USN\NAVAIR\ORLO\Functional Mail

Loading Muster Mailbox content

LoadMailBox, Icount = 1 MessageCount=630

SentOn = 6/23/2010 3:23:51 PM

SentOn = 6/23/2010 3:23:51 PM

Subject = MANUAL MUSTER 23 JUNE 2010.xlsx

LoadMailBox, Icount = 2 MessageCount=630

SentOn = 6/23/2010 2:34:15 PM

SentOn = 6/23/2010 2:34:15 PM

Subject = Muster for 6/23/2010 8:34:09 AM

LoadMailBox, Icount = 3 MessageCount=630

SentOn = 6/23/2010 2:29:16 PM

SentOn = 6/23/2010 2:29:16 PM

Subject = mark.peterson@navy.mil Muster for 6/23/2010 11:29:11 AM

LoadMailBox, Icount = 4 MessageCount=630

SentOn = 6/23/2010 2:06:22 PM

SentOn = 6/23/2010 2:06:22 PM

Subject = <WebMuster version="7E" dtg="6/23/2010 2:06:02 PM"/>

LoadMailBox, Icount = 5 MessageCount=630

SentOn = 6/23/2010 1:56:22 PM

SentOn = 6/23/2010 1:56:22 PM

Subject = FW: Out of the office 6/2510 - 7/5/10

LoadMailBox, Icount = 6 MessageCount=630

SentOn = 6/23/2010 1:22:33 PM

SentOn = 6/23/2010 1:22:33 PM

Subject = <WebMusterMe version="2" dtg="6/23/2010 7:21:46 AM"/>

LoadMailBox, Icount = 7 MessageCount=630

SentOn = 6/23/2010 1:18:45 PM

SentOn = 6/23/2010 1:18:45 PM

Subject = <WebMuster version="7I" dtg="6/23/2010 1:18:26 PM"/>

Our computers were upgraded to Office 2007. The following script fails to work on 2007, but works in 2003.

Look for the comment FAILS HERE

CreateObject("Outlook.Application") returns an error that the ActiveX object cannot be created:

Thanks for your help!!

Navy Firefighting Engineer

Ответы

Can you run this script on one of the systems with Outlook 2007 installed and post the exact message it prompts you with.

Knowing the error codes will help to determine the problem and resolution.

Is this still an open issue? Please advise. If there is no response within a week we will assume it is resolved and will close this post. Thanks

Все ответы

Can you run this script on one of the systems with Outlook 2007 installed and post the exact message it prompts you with.

Knowing the error codes will help to determine the problem and resolution.

Dim NS ' As NameSpace

Dim objOutlook ' As Application

' Dim objInbox As Outlook.MAPIFolder

Dim objFolder ' As Outlook.MAPIFolder

Dim Item ' As Object

Dim objItems ' As Object, MailItem but could be something else

Dim Icount ' Folder loop counter

Set NS = Nothing

set objOutlook = Nothing

strFolderName = "Public Folders/All Public Folders/USN/NAVAIR/ORLO/Functional Mailboxes/ORLO_498 MUSTER"

Const olFolderInbox = 6

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery _

("Select * From Win32_Process Where Name = 'outlook.exe'")

If colItems.Count > 0 Then wscript.echo "Outlook is running", 1

Set objOutlook = CreateObject("Outlook.Application")

Set objNamespace = objOutlook.GetNamespace("MAPI")

objNamespace.Logon "Default Outlook Profile",, False, True

Set objFolder = GetFolder(strFolderName)

wscript.echo "Using Mailbox: " & strFolderName

On Error Resume Next

wscript.echo ("LoadMailBox Messagecount=" & MessageCount), 1

wscript.echo "Loading Muster Mailbox content"

Set Item = objFolder.Items

'Set Item = objFolder.MailItems 'Outlook2007 seems to use MailItems instead of Items

On Error resume next

For Icount = 1 To MessageCount

' MessageCount comes from the count property of the folder in Outlook

wscript.echo "LoadMailBox, Icount = " & Icount & " MessageCount=" & MessageCount

wscript.echo "SentOn = " & Item(Icount).SentOn

'Outlook 2007 is having trouble with the item properties below

'Is it perhaps because the Outlook ObjectModell has changed?

wscript.echo "SenderName = " & Item(Icount).SenderName

if err.number <> 0 then

wscript.echo "Sender Name has a problem, Error Number " & err.number & " " & err.Description

wscript.echo "Subject = " & Item(Icount).Subject

wscript.echo "Body = " & Item(Icount).Body

' ******************* LOADING OF MESSAGES INTO MEMORY IS COMPLETE *****************

' This means all the messages, regardless of date

wscript.echo MessageCount & " Muster Messages found in LoadMailBox, Reading Inbox complete."

Public Function GetFolder(strFolderPath)

' folder path needs to be something like:

' "Public Folders\All Public Folders\Company\Sales"

Dim objApp ' As Outlook.Application

Dim objNS ' As Outlook.NameSpace

Dim colFolders ' As Outlook.Folders

Dim objFolder ' As Outlook.MAPIFolder

Dim arrFolders ' As String array

On Error Goto 0

'On Error Resume Next

if dbg then wscript.echo "GetFolder path = " & strFolderPath, 1

if dbg then wscript.echo "Adjusted folder path = " & strFolderPath

Set objApp = CreateObject("Outlook.Application")

' If Outlook is not installed, the folder will be nothing

If Err.number <> 0 Then

wscript.echo "Function GetFolder, CreateObject Outlook.Application"

On Error Goto 0

Set objNS = objApp.GetNamespace("MAPI")

Set objFolder = objNS.Folders.Item(arrFolders(0))

On Error Resume Next

If Not objFolder Is Nothing Then

For I = 1 To UBound(arrFolders)

Set colFolders = objFolder.Folders

Set objFolder = Nothing

Set objFolder = colFolders.Item(arrFolders(I))

If Err.Number <> 0 then

Msgbox "It appears that you do not have access permissions to the Muster Mailbox, call the Mailbox Owner"

if dbg then wscript.echo "Folder = " &objFolder, 1

If objFolder Is Nothing Then

Set GetFolder = objFolder

'If Dbg Then MsgBox("Getfolder is returning " & GetFolder)

On Error Resume Next

Set colFolders = Nothing

Set objNS = Nothing

Set objApp = Nothing

On Error Goto 0

Outlook is running

Using Mailbox: Public Folders\All Public Folders\USN\NAVAIR\ORLO\Functional Mail

Loading Muster Mailbox content

LoadMailBox, Icount = 1 MessageCount=630

SentOn = 6/23/2010 3:23:51 PM

SentOn = 6/23/2010 3:23:51 PM

Subject = MANUAL MUSTER 23 JUNE 2010.xlsx

LoadMailBox, Icount = 2 MessageCount=630

SentOn = 6/23/2010 2:34:15 PM

SentOn = 6/23/2010 2:34:15 PM

Subject = Muster for 6/23/2010 8:34:09 AM

LoadMailBox, Icount = 3 MessageCount=630

SentOn = 6/23/2010 2:29:16 PM

SentOn = 6/23/2010 2:29:16 PM

Subject = mark.peterson@navy.mil Muster for 6/23/2010 11:29:11 AM

LoadMailBox, Icount = 4 MessageCount=630

SentOn = 6/23/2010 2:06:22 PM

SentOn = 6/23/2010 2:06:22 PM

Subject = <WebMuster version="7E" dtg="6/23/2010 2:06:02 PM"/>

LoadMailBox, Icount = 5 MessageCount=630

SentOn = 6/23/2010 1:56:22 PM

SentOn = 6/23/2010 1:56:22 PM

Subject = FW: Out of the office 6/2510 - 7/5/10

LoadMailBox, Icount = 6 MessageCount=630

SentOn = 6/23/2010 1:22:33 PM

SentOn = 6/23/2010 1:22:33 PM

Subject = <WebMusterMe version="2" dtg="6/23/2010 7:21:46 AM"/>

LoadMailBox, Icount = 7 MessageCount=630

SentOn = 6/23/2010 1:18:45 PM

SentOn = 6/23/2010 1:18:45 PM

Subject = <WebMuster version="7I" dtg="6/23/2010 1:18:26 PM"/>

Читайте также: