PDA

View Full Version : Does



SM78258
11-26-2013, 07:25 AM
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
11-26-2013, 08:29 AM
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
11-27-2013, 04:55 AM
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
11-27-2013, 05:25 AM
Do you still have the same problem if Outlook is already running?

Kenneth Hobs
11-27-2013, 06:34 AM
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
11-27-2013, 06:39 AM
If Outlook were not installed I would expect a problem with the declarations before the code even attempted to run.

SM78258
11-27-2013, 07:25 AM
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
11-27-2013, 07:29 AM
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
11-27-2013, 12:25 PM
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-vba/early-late-binding/

Option Explicit should show incorrect syntax or missing reference code.

I try to use the Compile button before running code.