Does

[SM78258]

Hi guys,I'm a new member here, I've read all the rules but can't seem to find an answer to my specific situation. I use a Macro at work to extract data from Outlook and populate a spreadsheet. We've recently upgraded (from Windows XP to Windows 7) and now the Macro no longer works. The error message that appears is; 429: Active X Component can't create objectThe thing is it doesn't show me where any errors are in the code so I can't spot any issues.I'm wondering if I'm missing something, I've had a look into referencing and that doesn't seem to fix the issue... I've waited a while before posting on here in case I could solve this myself but my boss is expecting an answer by Friday and I'm clueless. Any help or hints would be much appreciated! I know my code is probably awful but I'll attach it anyway.Code:

Public Sub ImportOutlookItems()
   On Error GoTo HandleErr 
   Dim Olapp As Outlook.Application 
   Dim Olmapi As Outlook.NameSpace 
   Dim OlDealfolder As Outlook.MAPIFolder 
   Dim OlDealCountedfolder As Outlook.MAPIFolder 
   Dim OlMailbox As Outlook.MAPIFolder 
   Dim OlMail As Object 
   'Have to late bind as appointments e.t.c screw it up 
   Dim OlItems As Outlook.Items 
   Dim x, count_items As Integer
  'Create a connection to outlook 
   Set Olapp = CreateObject("Outlook.Application") 
   Set Olmapi = Olapp.GetNamespace("MAPI") 
   'Set OlMailbox = Olmapi.GetDefaultFolder(olFolderInbox) 
   'use this for personal default inbox 
   Sheets("Macro").Select 
   Set OlMailbox = Olmapi.Folders(ActiveSheet.Range("mailbox").Value) 
   Set OlDealfolder = OlMailbox.Folders("Inbox").Folders(ActiveSheet.Range("inbox").Value) 
   Set OlDealCountedfolder = OlDealfolder.Folders(ActiveSheet.Range("movedbox").Value) 
       Set OlItems = OlDealfolder.Items
   'move to the next new row in the spreadsheet 
   Sheets("Data").Select 
   ActiveSheet.Range("A2").Select 
   If Not Range("A2").Value = "" Then 
   'caters for a blank spreadsheet
   'move down a cell until a blank row is found 
       Do           
ActiveCell.Offset(1, 0).Activate 
       Loop Until ActiveCell.Value = Empty 
   End If 
   ' Count the number of items in the inbox 
   count_items = OlItems.Count     
'Set up a loop to run from last to first (otherwise it skips some) 
   For x = OlItems.Count To 1 Step -1 
       ActiveCell.Value = OlItems(x).SenderName 
       ActiveCell.Offset(0, 1).Activate        
ActiveCell.Value = OlItems(x).SentOn        
getContents (OlItems(x).body)        
ActiveCell.Offset(1, 0).Activate 
       Selection.End(xlToLeft).Select 
       OlItems(x).Move OlDealCountedfolder 
   Next x
   ActiveSheet.Unprotect   
Columns("A:C").Select
   Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   Range("A2").Select
  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True    
MsgBox "Update completed. " & count_items & " emails copied.", vbInformation, "Import Email"
ExitHere: 
   Exit SubHandleErr: 
   Select Case Err Case 
Else 
           MsgBox Err & ": " & Err.Description 
   End Select 
   Resume ExitHere
End Sub

Function getContents(body) As Boolean
Dim temp As String
Dim pos As Integer
Dim temp_length As Integer
If Not InStr(1, body, "StartForm=") Then
   MsgBox "A message in this folder does not have the appropriate start tag.", vbCritical' 
   getContents = False
   Exit Function
End If
While InStr(1, body, "=")       
temp_length = InStr(1, body, Chr(13)) - InStr(1, body, "=") - 1        
pos = InStr(1, body, Chr(13)) + 1        
temp = Mid(body, InStr(1, body, "=") + 1, temp_length)        
body = Mid(body, pos) 
       If temp = "Submit" Then 
Exit Function 
       If InStr(1, temp, "=") = 0 Then 
           ActiveCell.Offset(0, 1).Activate            
ActiveCell.Value = temp 
       End If
Wend
End Function

Thanks for your time guys!

[Paul_Hossler]

1. Welcome

2. Could you re-post the code using the # icon to add the bracketing [ CODE ] and [/ CODE] tags around it?

3. If you single step through the macro, were does it fail?

Paul

[snb]

Comment out the on error line and step through the code : F8

Does the workbook contain the named ranges 'mailbox', 'inbox' en 'movedbox' ?

Does Outlook contain the folders indicated in the named ranges 'mailbox', 'inbox' en 'movedbox' ?

[Aflatoon]

Do you still have the same problem if Outlook is already running?

[Kenneth Hobs]

Sounds like you are not using Outlook nor is it installed since it could not find the object.

Try a CDO method. http://www.rondebruin.nl/win/s1/cdo.htm

[Aflatoon]

If Outlook were not installed I would expect a problem with the declarations before the code even attempted to run.

[SM78258]

Hi all,Firstly thanks for all your responses and apologies for not posting correctly to begin with.It is odd that there is a problem before the code even attempts to run, as Aflatoon said, but Outlook is definitley installed and up and running. I'm unable to work through the code step by step as it won't even start so it's hard to spot any specific error. I'm wondering if you guys are right and perhaps there is an issue with my Outlook...Thanks for all your suggestions, I'll be looking into all of your suggestions now and I'll see what I can come up with!

[Aflatoon]

Can you check which version of Outlook is referenced (Tools-References in the VBEditor)? Is it the same one you are running, and the same version as the rest of Office?

[Kenneth Hobs]

Dim is what determines if you are using Late or Early binding. You are using early binding. As Aflatoon said, check Tools > References, to see if you have a Missing reference or invalid reference.

Late vs. Early Binding: http://www.jpsoftwaretech.com/excel-...-late-binding/

Option Explicit should show incorrect syntax or missing reference code.

I try to use the Compile button before running code.