Solved

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

Posted on 2015-01-06
13
321 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:SimonAdept
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:SimonAdept
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:SimonAdept
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

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:SimonAdept
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:
SimonAdept 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

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

Suggested Solutions

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

744 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

13 Experts available now in Live!

Get 1:1 Help Now