mvidas
asked on
MAPI / Late Binding
Hi Everyone,
I've got a macro interfacing outlook from excel. I am testing this on my home computer (written at work), and im now getting an error message on the line
Set objSession = CreateObject("MAPI.Session ")
Run-time error '429':
ActiveX component can't create object
I'll post the full code if requested, but does anyone have any idea why it's not working?
Thanks!
Matt
I've got a macro interfacing outlook from excel. I am testing this on my home computer (written at work), and im now getting an error message on the line
Set objSession = CreateObject("MAPI.Session
Run-time error '429':
ActiveX component can't create object
I'll post the full code if requested, but does anyone have any idea why it's not working?
Thanks!
Matt
ASKER
Hey Patrick, heres my code up to that line:
Private Sub ImportButton_Click()
'Will import all selected messages in current outlook window and import into new excel
' spreadsheet, and will embed any/all attachments
'Sender Email routine modified from http://www.outlookcode.com/d/code/getsenderaddy.htm
'Basic outlook use from Will_Scarlet7@EE https://www.experts-exchange.com/questions/21165137/Export-to-excel.html
Dim oOutlook, oSelection, oMessage, objSession, objCDOMsg, strEntryID, strStoreID, Atch
Dim olNS, DelItemsFolder
Dim SndName As String, SndAddr As String, ToName As String, CCName As String
Dim Subj As String, Rcvd As String, MsgBody As String, AtchName As String
Dim AtchCell As Range, MsgCount As Integer, Cntr As Long
OutlookImport.Hide
Application.ScreenUpdating = False
Set oOutlook = CreateObject("Outlook.Appl ication")
Set olNS = oOutlook.GetNamespace("MAP I")
Set DelItemsFolder = olNS.GetDefaultFolder(3)
On Error Resume Next
Set oSelection = oOutlook.ActiveExplorer.Se lection
If Err.Number = 91 Then
MsgBox "Outlook is not open, or another error has occurred. Exiting."
GoTo ExitImportFromOutlook
End If
On Error GoTo 0
Set objSession = CreateObject("MAPI.Session ")
objSession.Logon "", "", False, False
I (think I) need to be able to logon to the objsession though
Private Sub ImportButton_Click()
'Will import all selected messages in current outlook window and import into new excel
' spreadsheet, and will embed any/all attachments
'Sender Email routine modified from http://www.outlookcode.com/d/code/getsenderaddy.htm
'Basic outlook use from Will_Scarlet7@EE https://www.experts-exchange.com/questions/21165137/Export-to-excel.html
Dim oOutlook, oSelection, oMessage, objSession, objCDOMsg, strEntryID, strStoreID, Atch
Dim olNS, DelItemsFolder
Dim SndName As String, SndAddr As String, ToName As String, CCName As String
Dim Subj As String, Rcvd As String, MsgBody As String, AtchName As String
Dim AtchCell As Range, MsgCount As Integer, Cntr As Long
OutlookImport.Hide
Application.ScreenUpdating
Set oOutlook = CreateObject("Outlook.Appl
Set olNS = oOutlook.GetNamespace("MAP
Set DelItemsFolder = olNS.GetDefaultFolder(3)
On Error Resume Next
Set oSelection = oOutlook.ActiveExplorer.Se
If Err.Number = 91 Then
MsgBox "Outlook is not open, or another error has occurred. Exiting."
GoTo ExitImportFromOutlook
End If
On Error GoTo 0
Set objSession = CreateObject("MAPI.Session
objSession.Logon "", "", False, False
I (think I) need to be able to logon to the objsession though
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Instead of
Set objSession = CreateObject("MAPI.Session ")
objSession.Logon "", "", False, False
you should be able to replace those lines with:
olNS.Logon Profile:="myProfile", Password:="myPassword", ShowDialog:=False, NewSession:=True
Set objSession = CreateObject("MAPI.Session
objSession.Logon "", "", False, False
you should be able to replace those lines with:
olNS.Logon Profile:="myProfile", Password:="myPassword", ShowDialog:=False, NewSession:=True
ASKER
Hey guys, i had to run to the store, took a bit longer than expected
Dave, I do NOT have cdo.dll on my pc, chances are thats a good reason why its not working, if its invoking the cdo object. Is this a downloadable file? ive got office 2000 SP-3 at home if that helps. I got that aspect of the code from http://www.outlookcode.com/d/code/getsenderaddy.htm so i could get the email address of the sender.. do you know a different way i could do this?
Patrick,
I tried that, and it got past that part of it (did logon), but bombed at a future line
'Set objCDOMsg = objSession.GetMessage(strE ntryID, strStoreID)
Set objCDOMsg = olNS.getmessage(strEntryID , strStoreID)
Do you think it could be something besides cdo.dll for this reason? That line is the only other line to use objSession besides just the logoff and =nothing, and those two worked fine
I could post my whole code, but its about 150 lines now (a little bit different from my post on vbax). if either of you (or anyone else) thinks i should, I gladly will
Dave, I do NOT have cdo.dll on my pc, chances are thats a good reason why its not working, if its invoking the cdo object. Is this a downloadable file? ive got office 2000 SP-3 at home if that helps. I got that aspect of the code from http://www.outlookcode.com/d/code/getsenderaddy.htm so i could get the email address of the sender.. do you know a different way i could do this?
Patrick,
I tried that, and it got past that part of it (did logon), but bombed at a future line
'Set objCDOMsg = objSession.GetMessage(strE
Set objCDOMsg = olNS.getmessage(strEntryID
Do you think it could be something besides cdo.dll for this reason? That line is the only other line to use objSession besides just the logoff and =nothing, and those two worked fine
I could post my whole code, but its about 150 lines now (a little bit different from my post on vbax). if either of you (or anyone else) thinks i should, I gladly will
ASKER
By the way, as i noted above, my code works fine at work, where i must have cdo.dll. i brought it home to test it out and also to try and fix an addition that im having trouble with (mdmackillop's findword vbax KB entry, having trouble getting it to work for some reason). i didnt expect this would happen, but thats the benefit of testing i guess
Matt,
Try:
Set objCDOMsg = olNS.GetItemFromID(strEntr yID, strStoreID)
Patrick
Try:
Set objCDOMsg = olNS.GetItemFromID(strEntr
Patrick
At this point, it probably makes sense to post the whole code :)
ASKER
Sure, to save some db space i was going to just post a txt file to download, but someone may get something from the code someday. its the ImportButton on a userform (named OutlookImport), and also calls another userform named Progress, just in case it helps. Actually, the whole file (pre-addin, but it will be someday) can be downloaded from here http://home.rochester.rr.com/mvidas/Outlook%20to%20Excel.xls
Just in case it helps
Heres the code though:
Private Sub ImportButton_Click()
'Will import all selected messages in current outlook window and import into new excel
' spreadsheet, and will embed any/all attachments
'Sender Email routine modified from http://www.outlookcode.com/d/code/getsenderaddy.htm
'Basic outlook use from Will_Scarlet7@EE https://www.experts-exchange.com/questions/21165137/Export-to-excel.html
Dim oOutlook, oSelection, oMessage, objSession, objCDOMsg, strEntryID, strStoreID, Atch
Dim olNS, DelItemsFolder
Dim SndName As String, SndAddr As String, ToName As String, CCName As String
Dim Subj As String, Rcvd As String, MsgBody As String, AtchName As String
Dim AtchCell As Range, MsgCount As Integer, Cntr As Long
OutlookImport.Hide
Application.ScreenUpdating = False
Set oOutlook = CreateObject("Outlook.Appl ication")
Set olNS = oOutlook.GetNamespace("MAP I")
Set DelItemsFolder = olNS.GetDefaultFolder(3)
On Error Resume Next
Set oSelection = oOutlook.ActiveExplorer.Se lection
If Err.Number = 91 Then
MsgBox "Outlook is not open, or another error has occurred. Exiting."
GoTo ExitImportFromOutlook
End If
On Error GoTo 0
Set objSession = CreateObject("MAPI.Session ")
objSession.Logon "", "", False, False
'olNS.Logon "", "", False, False
Workbooks.Add
Application.DisplayAlerts = False
Sheets(2).Delete
Sheets(2).Delete
Application.DisplayAlerts = True
MsgCount = oSelection.Count
Cntr = 0
Progress.LabelProgress.Wid th = 0
Progress.Show 0
For Each oMessage In oSelection
Cntr = Cntr + 1
Call Progress.Main(Cntr / MsgCount, "Importing Message " & Cntr & " of " & MsgCount)
If oMessage.class = 43 Then
Sheets.Add After:=Sheets(Sheets.Count )
Subj = oMessage.Subject
SndName = oMessage.SenderName
ToName = oMessage.To
CCName = oMessage.cc
MsgBody = oMessage.Body
Rcvd = oMessage.ReceivedTime
strEntryID = oMessage.EntryID
strStoreID = oMessage.Parent.StoreID
Set objCDOMsg = objSession.GetMessage(strE ntryID, strStoreID)
'Set objCDOMsg = olNS.getmessage(strEntryID , strStoreID)
On Error Resume Next
SndAddr = objCDOMsg.Sender.Address
If Err = &H80070005 Then
MsgBox "The Outlook E-mail and CDO Security Patches are " & _
"apparently installed on this machine. " & _
"You must response Yes to the prompt about " & _
"accessing e-mail addresses if you want to " & _
"get the From address.", vbExclamation, _
"GetFromAddress"
End If
On Error GoTo 0
Range("A1") = "From"
If SndAddr Like "*@*" Then
Range("B1") = SndName & " (" & SndAddr & ")"
Else
Range("B1") = SndName
End If
Range("A2") = "To"
Range("B2") = ToName
Range("A3") = "CC"
Range("B3") = CCName
Range("A4") = "Subject"
If Subj = "" Then Subj = " "
Range("B4") = Subj
Range("A5") = "Received"
Range("B5") = Rcvd
Range("B5").HorizontalAlig nment = xlLeft
Range("A6") = "Attachments"
Rows(6).RowHeight = 47.25
Range("A7") = "Body"
Range("B1:K1,B2:K2,B3:K3,B 4:K4,B5:K5 ").MergeCe lls = True
ProcessBody Range("B7"), MsgBody
Set AtchCell = Range("C6")
For Each Atch In oMessage.Attachments
If Atch.Type = 1 Then
AtchName = Atch.Filename
Atch.SaveAsFile "C:\DEL-ME-" & AtchName
If Right(AtchName, 3) = "xls" Then
Workbooks.Open "C:\DEL-ME-" & AtchName, False
ActiveWindow.Visible = False
End If
With ActiveSheet.OLEObjects.Add (Filename: ="C:\DEL-M E-" & AtchName, DisplayAsIcon:=True, _
Link:=False, Left:=AtchCell.Left, Top:=AtchCell.Top, Width:=AtchCell.Width, Height:=AtchCell.Height)
.ShapeRange.LockAspectRati o = msoFalse
.ShapeRange.Height = AtchCell.Height
.ShapeRange.Width = AtchCell.Width
End With
AtchCell.Offset(0, -1) = AtchName & ":"
AtchCell.Offset(0, -1).HorizontalAlignment = xlRight
AtchCell.Offset(0, -1).WrapText = True
Set AtchCell = AtchCell.Offset(0, 2)
On Error Resume Next
Workbooks("DEL-ME-" & AtchName).Close False
Kill "C:\DEL-ME-" & AtchName
On Error GoTo 0
End If
Next
Application.DisplayAlerts = True
Rcvd = Format([B5], "YYYYMMDD") & "-" & Format([B5], "hhmmss") & "-" & Left(Subj, 15)
Rcvd = Replace(Rcvd, Chr(58), "")
Rcvd = Replace(Rcvd, Chr(92), "")
Rcvd = Replace(Rcvd, Chr(47), "")
Rcvd = Replace(Rcvd, Chr(63), "")
Rcvd = Replace(Rcvd, Chr(42), "")
Rcvd = Replace(Rcvd, Chr(91), "")
Rcvd = Replace(Rcvd, Chr(93), "")
ActiveSheet.Name = Rcvd
Rcvd = ""
Range("A1").Select
Range("A6").Columns.AutoFi t
With ActiveSheet.PageSetup
.CenterHeader = Subj
.LeftMargin = Application.InchesToPoints (0.25)
.RightMargin = Application.InchesToPoints (0.25)
.TopMargin = Application.InchesToPoints (0.5)
.BottomMargin = Application.InchesToPoints (0.25)
.HeaderMargin = Application.InchesToPoints (0.25)
End With
End If
Next oMessage
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
Unload Progress
If MsgBox("Do you want to move the selected Outlook messages to " & DelItemsFolder.Name & _
"?", vbYesNo, "Delete Messages?") = vbYes Then
For Each oMessage In oSelection
If oMessage.class = 43 Then oMessage.Move DelItemsFolder
Next
End If
ExitImportFromOutlook:
Set oOutlook = Nothing
Set oMessage = Nothing
Set oSelection = Nothing
Set objCDOMsg = Nothing
objSession.Logoff
'olNS.Logoff
Set objSession = Nothing
Set olNS = Nothing
Sheets(1).Select
Application.ScreenUpdating = True
End Sub
In the file theres a module named ImportModule, which has the function ProcessBody and the sub AutoFitMC, in case you need to see those. if you can't get the file from where you are, i can post the code for those two as well if necessary.
Pretty neat thing, will be nicer once it gets working fully!
Just in case it helps
Heres the code though:
Private Sub ImportButton_Click()
'Will import all selected messages in current outlook window and import into new excel
' spreadsheet, and will embed any/all attachments
'Sender Email routine modified from http://www.outlookcode.com/d/code/getsenderaddy.htm
'Basic outlook use from Will_Scarlet7@EE https://www.experts-exchange.com/questions/21165137/Export-to-excel.html
Dim oOutlook, oSelection, oMessage, objSession, objCDOMsg, strEntryID, strStoreID, Atch
Dim olNS, DelItemsFolder
Dim SndName As String, SndAddr As String, ToName As String, CCName As String
Dim Subj As String, Rcvd As String, MsgBody As String, AtchName As String
Dim AtchCell As Range, MsgCount As Integer, Cntr As Long
OutlookImport.Hide
Application.ScreenUpdating
Set oOutlook = CreateObject("Outlook.Appl
Set olNS = oOutlook.GetNamespace("MAP
Set DelItemsFolder = olNS.GetDefaultFolder(3)
On Error Resume Next
Set oSelection = oOutlook.ActiveExplorer.Se
If Err.Number = 91 Then
MsgBox "Outlook is not open, or another error has occurred. Exiting."
GoTo ExitImportFromOutlook
End If
On Error GoTo 0
Set objSession = CreateObject("MAPI.Session
objSession.Logon "", "", False, False
'olNS.Logon "", "", False, False
Workbooks.Add
Application.DisplayAlerts = False
Sheets(2).Delete
Sheets(2).Delete
Application.DisplayAlerts = True
MsgCount = oSelection.Count
Cntr = 0
Progress.LabelProgress.Wid
Progress.Show 0
For Each oMessage In oSelection
Cntr = Cntr + 1
Call Progress.Main(Cntr / MsgCount, "Importing Message " & Cntr & " of " & MsgCount)
If oMessage.class = 43 Then
Sheets.Add After:=Sheets(Sheets.Count
Subj = oMessage.Subject
SndName = oMessage.SenderName
ToName = oMessage.To
CCName = oMessage.cc
MsgBody = oMessage.Body
Rcvd = oMessage.ReceivedTime
strEntryID = oMessage.EntryID
strStoreID = oMessage.Parent.StoreID
Set objCDOMsg = objSession.GetMessage(strE
'Set objCDOMsg = olNS.getmessage(strEntryID
On Error Resume Next
SndAddr = objCDOMsg.Sender.Address
If Err = &H80070005 Then
MsgBox "The Outlook E-mail and CDO Security Patches are " & _
"apparently installed on this machine. " & _
"You must response Yes to the prompt about " & _
"accessing e-mail addresses if you want to " & _
"get the From address.", vbExclamation, _
"GetFromAddress"
End If
On Error GoTo 0
Range("A1") = "From"
If SndAddr Like "*@*" Then
Range("B1") = SndName & " (" & SndAddr & ")"
Else
Range("B1") = SndName
End If
Range("A2") = "To"
Range("B2") = ToName
Range("A3") = "CC"
Range("B3") = CCName
Range("A4") = "Subject"
If Subj = "" Then Subj = " "
Range("B4") = Subj
Range("A5") = "Received"
Range("B5") = Rcvd
Range("B5").HorizontalAlig
Range("A6") = "Attachments"
Rows(6).RowHeight = 47.25
Range("A7") = "Body"
Range("B1:K1,B2:K2,B3:K3,B
ProcessBody Range("B7"), MsgBody
Set AtchCell = Range("C6")
For Each Atch In oMessage.Attachments
If Atch.Type = 1 Then
AtchName = Atch.Filename
Atch.SaveAsFile "C:\DEL-ME-" & AtchName
If Right(AtchName, 3) = "xls" Then
Workbooks.Open "C:\DEL-ME-" & AtchName, False
ActiveWindow.Visible = False
End If
With ActiveSheet.OLEObjects.Add
Link:=False, Left:=AtchCell.Left, Top:=AtchCell.Top, Width:=AtchCell.Width, Height:=AtchCell.Height)
.ShapeRange.LockAspectRati
.ShapeRange.Height = AtchCell.Height
.ShapeRange.Width = AtchCell.Width
End With
AtchCell.Offset(0, -1) = AtchName & ":"
AtchCell.Offset(0, -1).HorizontalAlignment = xlRight
AtchCell.Offset(0, -1).WrapText = True
Set AtchCell = AtchCell.Offset(0, 2)
On Error Resume Next
Workbooks("DEL-ME-" & AtchName).Close False
Kill "C:\DEL-ME-" & AtchName
On Error GoTo 0
End If
Next
Application.DisplayAlerts = True
Rcvd = Format([B5], "YYYYMMDD") & "-" & Format([B5], "hhmmss") & "-" & Left(Subj, 15)
Rcvd = Replace(Rcvd, Chr(58), "")
Rcvd = Replace(Rcvd, Chr(92), "")
Rcvd = Replace(Rcvd, Chr(47), "")
Rcvd = Replace(Rcvd, Chr(63), "")
Rcvd = Replace(Rcvd, Chr(42), "")
Rcvd = Replace(Rcvd, Chr(91), "")
Rcvd = Replace(Rcvd, Chr(93), "")
ActiveSheet.Name = Rcvd
Rcvd = ""
Range("A1").Select
Range("A6").Columns.AutoFi
With ActiveSheet.PageSetup
.CenterHeader = Subj
.LeftMargin = Application.InchesToPoints
.RightMargin = Application.InchesToPoints
.TopMargin = Application.InchesToPoints
.BottomMargin = Application.InchesToPoints
.HeaderMargin = Application.InchesToPoints
End With
End If
Next oMessage
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
Unload Progress
If MsgBox("Do you want to move the selected Outlook messages to " & DelItemsFolder.Name & _
"?", vbYesNo, "Delete Messages?") = vbYes Then
For Each oMessage In oSelection
If oMessage.class = 43 Then oMessage.Move DelItemsFolder
Next
End If
ExitImportFromOutlook:
Set oOutlook = Nothing
Set oMessage = Nothing
Set oSelection = Nothing
Set objCDOMsg = Nothing
objSession.Logoff
'olNS.Logoff
Set objSession = Nothing
Set olNS = Nothing
Sheets(1).Select
Application.ScreenUpdating
End Sub
In the file theres a module named ImportModule, which has the function ProcessBody and the sub AutoFitMC, in case you need to see those. if you can't get the file from where you are, i can post the code for those two as well if necessary.
Pretty neat thing, will be nicer once it gets working fully!
ASKER
Thanks Dave, that showed me that my office 2k should have installed it, so i put the cd in and realized that the cdo option was disabled, so i added it.
It works now, although it crashes at the end! it either crashes after the Set objSession=Nothing line, or if I comment that out it crashes after the macro finishes. It's giving me a Run-time error '-2147417848 (80010108)': Automation error, The object invoked has disconnected from it's clients. It shows me that window for about 2-3 seconds before giving me the "EXCEL.EXE has encountered errors..." popup.
I'll close this Q, as it does solve the original issue, but if either of you can help with this new error (or even just suggestions on what to try, im a bit tired and can't quite think of a way to fix it), I'll up the points on my pointer Q and award more there. I'd like to get this solved if I'm going to be adding it to the vbax KB, in case people are using this from computers like my home pc (strange it doesnt happen at work, but that is on a network server, maybe it has something to do with that).
Thanks
Matt
It works now, although it crashes at the end! it either crashes after the Set objSession=Nothing line, or if I comment that out it crashes after the macro finishes. It's giving me a Run-time error '-2147417848 (80010108)': Automation error, The object invoked has disconnected from it's clients. It shows me that window for about 2-3 seconds before giving me the "EXCEL.EXE has encountered errors..." popup.
I'll close this Q, as it does solve the original issue, but if either of you can help with this new error (or even just suggestions on what to try, im a bit tired and can't quite think of a way to fix it), I'll up the points on my pointer Q and award more there. I'd like to get this solved if I'm going to be adding it to the vbax KB, in case people are using this from computers like my home pc (strange it doesnt happen at work, but that is on a network server, maybe it has something to do with that).
Thanks
Matt
Hi Matt,
Thanks for the grade. :)
Maybe you could ask the questions in Excel in future as Patrick, Will & David Barker seem to have the Excel/Outlook questions well covered.
I did a google and didn't get too much besides this note from a T-card page
"Run - time error '-2147417848 (80010108)'Automation error The object invoked has disconnected from its clients after running several minutes OR error when trying to send an email: Motion detector was unable to send e-mail.:
With most system configurations WinTV-Zone requires a MAPI compliant e-mail client with a persistent internet connection, such as cable modem, DSL"
What sort of internet connection do you have at home? Have you tried the code at work?
Cheers
Dave
Thanks for the grade. :)
Maybe you could ask the questions in Excel in future as Patrick, Will & David Barker seem to have the Excel/Outlook questions well covered.
I did a google and didn't get too much besides this note from a T-card page
"Run - time error '-2147417848 (80010108)'Automation error The object invoked has disconnected from its clients after running several minutes OR error when trying to send an email: Motion detector was unable to send e-mail.:
With most system configurations WinTV-Zone requires a MAPI compliant e-mail client with a persistent internet connection, such as cable modem, DSL"
What sort of internet connection do you have at home? Have you tried the code at work?
Cheers
Dave
ASKER
I did put the pointer in Excel to this question to give it a bit more coverage but I put it here because this was an error on the Outlook side of it.
Strangely, I do use a cable connection for my internet at home, so it couldn't be that issue. The code works fine at work (where it is originally intended and will be used), but I just wanted to figure that issue out before I added it as a KB entry. It sounds like MD has the same issue with that line (based on his response on vbax), but in all honesty I don't know what else I can do to it. I'm going to use it here at work, and just work on it on the side before adding it to the KB. I'll probably post another question for the error when I get some time.
Thanks again
Strangely, I do use a cable connection for my internet at home, so it couldn't be that issue. The code works fine at work (where it is originally intended and will be used), but I just wanted to figure that issue out before I added it as a KB entry. It sounds like MD has the same issue with that line (based on his response on vbax), but in all honesty I don't know what else I can do to it. I'm going to use it here at work, and just work on it on the side before adding it to the KB. I'll probably post another question for the error when I get some time.
Thanks again
Glad to help, Matt.
I am afraid I cannot shed any light on the errors at the end--I rate myself as Advanced on Excel automation,
Intermediate on Word automation, but as rank Beginner on Outlook automation :)
Patrick
I am afraid I cannot shed any light on the errors at the end--I rate myself as Advanced on Excel automation,
Intermediate on Word automation, but as rank Beginner on Outlook automation :)
Patrick
Set objSession = olApp.GetNameSpace("MAPI")
That should create a MAPI session for you, right?
Patrick