Link to home
Start Free TrialLog in
Avatar of mvidas
mvidasFlag for United States of America

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
Avatar of Patrick Matthews
Patrick Matthews
Flag of United States of America image

Assuming you have an object called olApp set to the Outlook application already, try:

    Set objSession = olApp.GetNameSpace("MAPI")

That should create a MAPI session for you, right?

Patrick
Avatar of mvidas

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.Application")
 Set olNS = oOutlook.GetNamespace("MAPI")
 Set DelItemsFolder = olNS.GetDefaultFolder(3)
 On Error Resume Next
 Set oSelection = oOutlook.ActiveExplorer.Selection
 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
Avatar of Dave
Dave
Flag of Australia 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
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
Avatar of mvidas

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(strEntryID, 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
Avatar of mvidas

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(strEntryID, strStoreID)

Patrick
At this point, it probably makes sense to post the whole code :)
Avatar of mvidas

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.Application")
 Set olNS = oOutlook.GetNamespace("MAPI")
 Set DelItemsFolder = olNS.GetDefaultFolder(3)
 On Error Resume Next
 Set oSelection = oOutlook.ActiveExplorer.Selection
 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.Width = 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(strEntryID, 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").HorizontalAlignment = xlLeft
   Range("A6") = "Attachments"
   Rows(6).RowHeight = 47.25
   Range("A7") = "Body"
   Range("B1:K1,B2:K2,B3:K3,B4:K4,B5:K5").MergeCells = 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-ME-" & AtchName, DisplayAsIcon:=True, _
      Link:=False, Left:=AtchCell.Left, Top:=AtchCell.Top, Width:=AtchCell.Width, Height:=AtchCell.Height)
      .ShapeRange.LockAspectRatio = 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.AutoFit
   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!
Avatar of mvidas

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
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
Avatar of mvidas

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

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