Solved

the attempted operation failed. An object could not be found Excel 2010

Posted on 2015-01-06
13
336 Views
Last Modified: 2015-01-07
I have a function that when a button is clicked in my Excel 2010 spreadsheet it accesses data from an email in my Outlook inbox and pastes it in my spreadsheet.

However, I recently had to replace my hard drive. Now when I try to work the function I get this error:
"the attempted operation failed. An object could not be found"

What do I do?
0
Comment
Question by:mabehr
  • 7
  • 5
13 Comments
 
LVL 18

Expert Comment

by:Simon
ID: 40533365
Right-click the button to find which macro is attached to it, then set a breakpoint on the fist line
Click the button to call the macro and press F8 to step through it until you find which line it breaks at.
Post the line in question, or the whole function in a reply here to get some further help.
0
 
LVL 9

Expert Comment

by:dlb6597
ID: 40533400
i suspect either a missing excel add-in or your macro had some reliance on a specific outlook profile or mailbox. maybe after your hard drive replacement your outlook profile has a different name, or a specific mailbox is not configured to open now (if it is a mailbox other than your personal mailbox).
0
 

Author Comment

by:mabehr
ID: 40533451
It's an IMAP configured Inbox so everything is the same as far as my inbox is concerned.

Private Sub CommandButton2_Click()
ImportWesternUnion
End Sub

Open in new window


and in a module (take a deep breath, it is long):

Sub ImportWesternUnion()
Dim WS As Worksheet
Dim objOutlook As Object
Dim Rng As Range, RngCardHolder As Range
Dim arrRows() As String
Dim arrRow() As String
Dim elem As Variant
Dim FMonitor, FTransfer
Dim FoundDivider As Boolean, FirstItemInMail As Boolean, StartDivider As Boolean
Dim CardNumber As String, CardHolder As String, TmpCardHolder As String
Dim SenderEmail As String
Dim Divider As String
Dim I As Long, J As Long, K As Long, L As Long
Dim C, FirstAddress, Items
Dim TmpAmount As String
Dim Fields As String, Possibility As String
Dim LenItem As Long, ColJRow As Long, ColARow As Long
Dim eType As String

Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set WS = Sheets("WU-Staging-FBME")


FMonitor = Split(Mid(gstFolderToMonitor, 2), "\")
If Not SetMonitorFolder(FMonitor) Then Exit Sub
wsMain.Range("L" & CRow) = "Import Western Union - FMonitor: " & objFolderToMonitor
CRow = CRow + 1

'Disabled in this procedure as user do not want to move emails.
'FTransfer = Split(Mid(gstFolderToTransfer, 2), "\")
'If Not SetTransferFolder(FTransfer) Then Exit Sub
'wsMain.Range("L" & CRow) = "Locate Emails - FTransfer: " & objFolderToTransfer
'CRow = CRow + 1

Dim VItem As Outlook.MailItem

Set VisaItems = objFolderToMonitor.Items.Restrict("[Subject] <> 'Payment Received'")
VisaItems.Sort "receivedtime", False

'Setting Value of I depending on last item in Col J
ColJRow = WS.Range("J:J").Rows(WS.Range("J:J").Rows.Count).End(xlUp).Row
ColARow = WS.Range("A:A").Rows(WS.Range("A:A").Rows.Count).End(xlUp).Row
WS.Range("D:D").NumberFormat = "@"

If ColARow = ColJRow Then
    I = 1
Else
    I = WS.Cells(ColARow, 1) + 1
End If

Application.EnableEvents = False

For Each VItem In VisaItems
    wsMain.Range("L" & CRow) = "Import WU/MG - Items: " & I & " " & VItem.SenderEmailAddress & " " & VItem
    CRow = CRow + 1

    Set objMail = VItem
    ' use Instr here to check subject or body
    'MsgBox objMail.Subject
    '---> Do not process replied mails.
    If Left(UCase(objMail.Subject), 3) <> "RE:" Then
    
        Body = objMail.Body
        Etime = objMail.ReceivedTime
        CardNumber = ""
        FoundDivider = False
        StartDivider = False
        FirstItemInMail = True
        SenderEmail = objMail.SenderEmailAddress
        
        
        'Split Email address
        Select Case Trim(UCase(SenderEmail))
            Case "WHITE@SECURENYM.NET"
                CardHolder = "Jen" & Format(Etime, "mmddyy")
            Case "FISHERMAN@ALPINAASIA.COM"
                CardHolder = "ChrisCrozier" & Format(Etime, "mmddyy")
            Case "KONG@SECURENYM.NET"
                CardHolder = "Shawn" & Format(Etime, "mmddyy")
            Case "INFO@HOLMSENTREPRISES.COM"
                CardHolder = "Holms" & Format(Etime, "mmddyy")
            Case Else
                CardHolder = SenderEmail & Format(Etime, "mmddyy")
        End Select
        
        'Check to see if Combination CardHolder + Col C date already exist then increment CardHolder by 1
        With WS.Range("M:M")
            TmpCardHolder = CardHolder
            K = 2
            Do
                Set C = .Find(TmpCardHolder, LookIn:=xlValues, lookat:=xlPart)
                If Not C Is Nothing Then
                    TmpCardHolder = CardHolder & "-" & Format(K)
                    K = K + 1
                End If
            Loop Until C Is Nothing
            CardHolder = TmpCardHolder
    
        End With
    
        
        '---> Trap WU or MG Emails
        If InStr(1, UCase(Body), "MTCN", vbTextCompare) > 0 Or InStr(1, UCase(Body), "MG", vbTextCompare) > 0 Or InStr(1, UCase(Body), "REF#", vbTextCompare) > 0 Then
            
            '---> Set Type of Email for future use
            If InStr(1, UCase(Body), "MTCN", vbTextCompare) > 0 And (InStr(1, UCase(Body), "MG", vbTextCompare) > 0 Or InStr(1, UCase(Body), "REF#", vbTextCompare) > 0) Then
                eType = "MIX"
            Else
                If InStr(1, UCase(Body), "MTCN", vbTextCompare) > 0 Then eType = "WU"
                If (InStr(1, UCase(Body), "MG", vbTextCompare) > 0 Or InStr(1, UCase(Body), "REF#", vbTextCompare) > 0) Then eType = "MG"
            End If
            
            If Rng Is Nothing Then
                Set Rng = WS.Range("B" & WS.UsedRange.Rows.Count).Offset(1, 0)
                Rng.Offset(1, 0).EntireRow.Insert
                WS.Range(Rng.Offset(0, -1), Rng.Offset(0, 39)).Interior.ColorIndex = 6
                'Made to trap yellow lines for Export Email
                Rng.Offset(0, 2).Value = " "
            Else
                Rng.Offset(1, 0).EntireRow.Insert
                WS.Range(Rng.Offset(1, -1), Rng.Offset(1, 39)).Interior.ColorIndex = 6
                'Made to trap yellow lines for Export Email
                Rng.Offset(1, 2).Value = " "
                Set Rng = Rng.Offset(1, 0)
            End If
            arrRows = Split(Body, vbCrLf, , vbTextCompare)
            For Each elem In arrRows
        
                'Spot Card Number as 'CARD #'
                If (InStr(1, UCase(elem), "CARD #", vbTextCompare) > 0 Or InStr(1, UCase(elem), "CARD#", vbTextCompare) > 0) And CardNumber = "" Then
                    If InStr(1, UCase(elem), "CARD #", vbTextCompare) > 0 Then CardNumber = Trim(Mid(elem, InStr(1, UCase(elem), "CARD #", vbTextCompare) + 6))
                    If InStr(1, UCase(elem), "CARD#", vbTextCompare) > 0 Then CardNumber = Trim(Mid(elem, InStr(1, UCase(elem), "CARD#", vbTextCompare) + 5))
                    
                    If Not IsNumeric(CardNumber) Then
                        TmpCardNumber = ""
                        For J = 1 To Len(CardNumber)
                            If IsNumeric(Mid(CardNumber, J, 1)) Then TmpCardNumber = TmpCardNumber & Mid(CardNumber, J, 1)
                        Next J
                        CardNumber = TmpCardNumber
                    End If
                    'To prevent other routines to interact
                    elem = ""
                End If
                    
                'Spot when block does not have semicolumn as divider in semicolumn ':' or else use space ' '
                If Left(Trim(elem), 1) <> "-" And Left(Trim(elem), 1) <> "=" And Left(Trim(elem), 1) <> "*" And Trim(elem) <> "" Then
                    If InStr(elem, ":") > 0 Then
                        If InStr(InStr(elem, ":") + 1, elem, ":") > 0 Then
                            Divider = " "
                        Else
                            Divider = ":"
                        End If
                    Else
                        If InStr(elem, ";") > 0 Then
                            If InStr(InStr(elem, ";") + 1, elem, ";") > 0 Then
                                Divider = " "
                            Else
                                Divider = ";"
                            End If
                        Else
                            If InStr(elem, " ") > 0 Then
                                Divider = " "
                            Else
                                Divider = ""
                            End If
                        End If
                    End If
                End If
                    
                'Spot beginning of Items
                If Left(elem, 1) = "-" Or Left(elem, 1) = "=" Then
                    FoundDivider = True
                    StartDivider = True
                End If
                
                
                'Spot Dividers in semicolumn ':' or else use space ' '
                LenItem = 0
                Possibility = ""
                If eType = "MIX" And FoundDivider Then
                    If InStr(1, UCase(elem), "MTCN", vbTextCompare) > 0 Then eType = "WU"
                    If InStr(1, UCase(elem), "MG", vbTextCompare) > 0 Or InStr(1, UCase(elem), "REF#", vbTextCompare) > 0 Then eType = "MG"
                End If
                
                If eType = "WU" Then Fields = "MTCN|MTCN#|MCTN|MCTN#|MTCN #|MTC#|MTCN;"
                If eType = "MG" Then Fields = "MG|MG#|MG #|MG;|REF#"
                
                Items = Split(Fields, "|")
                For L = 0 To UBound(Items)
                    If InStr(1, elem, Items(L), vbTextCompare) > 0 Then
                        If Len(Items(L)) > LenItem Then
                            Possibility = Items(L)
                            LenItem = Len(Items(L))
                        End If
                    End If
                Next L
                If Possibility <> "" Then
                    If Not FoundDivider Then FoundDivider = True
                    If Divider = "" Then
                        Divider = " "
                        elem = Possibility & Divider & Mid(elem, Len(Possibility) + 1)
                    End If
                End If
                    
                If InStr(elem, Divider) > 0 And Divider <> "" Then
                    arrRow = Split(elem, Divider)
                    'Select Case Trim(UCase(CStr(arrRow(0))))
                    '    Case "MTCN", "MTCN#", "MCTN", "MCTN#", "MTCN #", "MTC#", "MTCN;"
                    '        If Not FoundDivider Then FoundDivider = True
                    '
                    'End Select
                
                    
                    If FoundDivider And StartDivider Then
                        'Delete Row if no values
                        If WS.Range(Rng.Offset(0, -1), Rng.Offset(0, 39)).Interior.ColorIndex <> 6 And Rng.Offset(0, 0).Value = "" And Rng.Offset(0, 2).Value = "" And Rng.Offset(0, 3).Value = "" And Rng.Offset(0, 5).Value = "" Then
                            RngDeletd = WS.Cells(Rng.Row - 1, Rng.Column).Address
                            WS.Range(Rng.Row & ":" & Rng.Row).EntireRow.Delete
                            Set Rng = WS.Range(RngDeletd)
                            I = I - 1
                        End If
                        Set Rng = Rng.Offset(1, 0)
                        Rng.Offset(0, 1) = Format(Etime, "dd mmm yyyy")
                        Rng.Offset(0, -1) = I
                        Rng.Offset(0, 11) = CardHolder
                        If FirstItemInMail Then
                            Rng.Offset(0, 16) = CardNumber
                            If Left(CardNumber, 1) = "4" Then Rng.Offset(0, 17) = "EUR"
                            If Left(CardNumber, 1) = "5" Then Rng.Offset(0, 17) = "USD"
                            FirstItemInMail = False
                        End If
                        wsMain.Range("L" & CRow) = "    Item: " & I & " " & VItem.SenderEmailAddress
                        CRow = CRow + 1
                        I = I + 1
                        FoundDivider = False
                    End If
                    
                    
                    If Divider = " " And (CardNumber <> "" Or StartDivider = True) Then
                         X = UpdateItemFound(Rng, elem, eType)
                    Else
                        Select Case Trim(UCase(CStr(arrRow(0))))
                            Case "MTCN", "MTCN#", "MCTN", "MCTN#", "MTCN #", "MTC#", "MTCN;"
                                'Fix to importing MCTN with all characters including leading and trailing zeros
                                If Trim(arrRow(1)) <> "" Then
                                    Rng.Offset(0, 2) = Trim(Format(arrRow(1), "@"))
                                Else
                                    If UBound(arrRow) > 1 Then
                                        Rng.Offset(0, 2) = Trim(Format(arrRow(2), "@"))
                                    End If
                                End If
                            Case "MG", "MG#", "MG #", "MG;", "REF#"
                                'Fix to importing MG with all characters including leading and trailing zeros
                                If Trim(arrRow(1)) <> "" Then
                                    Rng.Offset(0, 2) = Trim(Format(arrRow(1), "@"))
                                Else
                                    If UBound(arrRow) > 1 Then
                                        Rng.Offset(0, 2) = Trim(Format(arrRow(2), "@"))
                                    End If
                                End If
                            Case "RECEIVER", "RECIEVER INFO", "RECEIVER NAME", "RECIEVER", "RECEVIER", "RECIVER", "RCVR"
                                Rng = Trim(arrRow(1))
                            Case "SENDER LOCATION", "LOCATION", "SENDER'S W.U. LOCATION", "SENDER'S W.U. LOCATION(CITY & STATE)", "SENDERS W.U. LOCATION", "SENDER'S W.U. LOCATION (CITY AND STATE)", "SENDER'S LOCATION", "SENDER INFO", "SENDER LOC ", "W U LOCATION", "SENDER WU LOCATION", "SEND LOC ", "SENDER LOC", "SENDER LOC", "SENDERS WU LOCATIONS", "SENDERS W.U'S LOCATION", "SENDERS W/U LOCATION", "ADDRESS", "SENDERS W.U. LOCATION", "SENDERS LOCATION", "SENDER WU LOCATION", "SENDER LOCATION SENT", "SENDER W/U LOCATION", "SENDER W.U. LOCATION", "W.U. LOCATION", "W/U LOCATION", "W.U. LOCTION", "SENDER LOC.", "AMT SENT", "SENT FROM", "WU LOCATION", "LOCATION.", "LOC.", "SENDING WU LOCATION", "CITY", "YOUR LOCATION"
                                Rng.Offset(0, 4) = Trim(arrRow(1))
                            Case "AMOUNT", "AMT", "AMOUNT SENT", "TOTAL", "TOTAL AMOUNT", "AOUNT", "MOUNT", "AMMOUNT", "AMNT", "AMOUNT $"
                                'Fix to importing amount as a number formated as $currency with double digits and
                                'Red if negatives
                                If Not IsNumeric(arrRow(1)) Then
                                    TmpAmount = ""
                                    For J = 1 To Len(elem)
                                        If IsNumeric(Mid(elem, J, 1)) Or Mid(elem, J, 1) = "." Then TmpAmount = TmpAmount & Mid(elem, J, 1)
                                    Next J
                                    arrRow(1) = TmpAmount
                                End If
                                If arrRow(1) <> "" Then Rng.Offset(0, 5) = CDbl(arrRow(1))
                                Rng.Offset(0, 5).NumberFormat = "$#,##0.00;[Red]($#,##0.00)"
                            Case "SENDER", "ENDER"
                                Rng.Offset(0, 3) = Trim(arrRow(1))
                            Case Else
                        End Select
                        
                    End If
                End If
                
            Next elem
        End If
    Else
        wsMain.Range("L" & CRow) = "Import WU/MG - Items: " & I & " Not Processed as History Mail."
        CRow = CRow + 1
    End If
Next VItem

Application.EnableEvents = True

'WS.UsedRange.EntireColumn.AutoFit
X = MsgBox("Total of " & I & " WU/MG detailed transfer imported successfully." & Chr(10) _
    & "Please check data in sheet 'WU-Staging-FBME' and make necessary corrections if any before proceeding to Step 2 - [Generate WU File]", vbInformation, "Step 1 - Import WU Emails")

End Sub

Open in new window

0
 
LVL 18

Expert Comment

by:Simon
ID: 40533572
Yup, it is long (as the actress allegedly said to the bishop)...

Could you put a breakpoint on the ImportWesterUnion line in the command button2_click routine and then step through and let us know where it breaks?

I'm assuming that you get this error at runtime but that it compiles OK? - if unsure, type and extra return on a blank line in the module and then re-compile it.
0
 

Author Comment

by:mabehr
ID: 40534818
I'm not familiar with break points but here's a screenshot:

break point run
0
 
LVL 18

Expert Comment

by:Simon
ID: 40535092
Thanks. You've set the breakpoint successfully in that image. Now you press the command button to call that code and then step thru the code by pressing F8 and watching which line is hightlighted in yellow until you get to the error.

The code you posted depends on other functions (possibly in other modules) so can't easily be tested by anyone else.
e.g.
setmonitorfolder
UpdateItemFound

I can see that your code requires a reference to be set to Microsoft Outlook (in Tools/References).

Is this sheet still in your workbook?
Set WS = Sheets("WU-Staging-FBME")

Fastest way to resolve this if definitely for you to step thru the code by repeatedly pressing F8 and letting us know the code on the line it errors at.
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:mabehr
ID: 40535422
Yes, WU-Staging-FBME is still a sheet in the workbook.

I stepped thru until came up with error and this is what came up:

error
0
 
LVL 18

Expert Comment

by:Simon
ID: 40535565
OK. I see that the code you provided relies on a number of external variables and functions, among which are these:
Variables
gstFolderToMonitor
wsMain
CRow

Functions
SetMonitorFolder
UpdateItemFound

On the line that causes the error, wsMain has not been defined within your routine. I would guess that it is an object reference to a worksheet - similar to the 'set WS = Sheets("WU-Staging_FBME") line. Maybe it is set in the function "SetMonitorFolder" which you haven't included in the code you posted. That function may indeed be in a missing add-in as dlb6597 suggested.
the function SetMonitorFolder(FMonitor) in turn relies on the variable FMonitor, which is the result of splitting a string variable "gstFolderToMonitor" which is also not defined in the current routine. It may be set elsewhere in your workbook by a setup routine.

The line following your current error line  would also fail because "CRow" has not been defined in this routine.

In summary:
the routine you posted relies on external variables and routines. The immediate issue is that the object variable wsMain has not been instantiated when the line of code you highlighted is evaluated. This may be due to a missing add-in, or misconfiguration of some other related variable.
I would suggest you post a copy of the whole workbook after removing any sensitive data, because we can only guess at what the externally set variable values are or what the other functions do.
0
 

Author Comment

by:mabehr
ID: 40535593
Attached is scrubbed workbook.

VISASPREADSHEET-November-3-14-scrubbed.x
0
 

Author Comment

by:mabehr
ID: 40535594
it is an .xlsm file. Not sure why it didn't post the whole file name
0
 
LVL 18

Accepted Solution

by:
Simon earned 500 total points
ID: 40535737
Thanks. I had to add one missing worksheet to the workbook to get the auto_open macro to work;
"Wire-Staging_FBME"

I initially got the same error as you, UNTIL I changed the combo box 'Choose an Outlook Folder to Monitor emails' to a different folder.

Although the auto-open macros build a list of folders on the fly, the displayed value remains unchanged - for me that was obviously an invalid option - "\\Michael - Sovereign..." and this caused the failure on the line you showed me. When I reset the combo value to one of the list it had populated the  'Choose an Outlook Folder to Monitor emails'  combo box with, that part of the routine worked fine. I suspect you'll need to do the same.
0
 

Author Comment

by:mabehr
ID: 40535856
I'll try that when I get back home. Strange, in the past it always prompted me if the combo box was not pointing to the right folder. And besides that, I thought I had changed it, but I will work with that tonight. Thanks.
0
 

Author Closing Comment

by:mabehr
ID: 40537171
Wow! It was that easy! Thanks. I missed that. Your help is much appreciated.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now