Createobject outlook application ошибка
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
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.
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 = [email protected] 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 = [email protected] 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"/>
Читайте также: