Errors trying to import Excel file from Outlook message

sharky12345

Well-known Member
Joined
Aug 5, 2010
Messages
3,404
Office Version
  1. 2016
Platform
  1. Windows
I am getting a random error 91 using the following code, the error reading 'Object variable or With block variable not set'.

The procedure is supposed to check the selected Outlook message and if if has an Excel file attached which has part of the filename being 'Raw Data' then it should open it and get data from that file. This error is not happening all of the time, it's only happening to some users some of the time so any help would be very much appreciated. Equally, if anyone can suggest a more efficient method to achieve this then I;m very interested!

Code:
    Dim objOL As Outlook.Application    Dim objMsg As Outlook.MailItem    'Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim DateText As String
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderPath As String
    Dim Counter As Long
    Dim wbA As Workbook, wbB As Workbook
    Dim FilePath As String


Application.ScreenUpdating = False
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
strFullPath = ThisWorkbook.Path & "\System Files"
If Not Dir(strFullPath, vbDirectory Or vbHidden) = vbNullString Then
Else
  MkDir strFullPath
End If
strFolderPath = strFullPath & "\"
strFolderPath = strFolderPath
    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")
    ' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
    ' Set the Attachment folder.
strFolderPath = strFolderPath
    ' Check each selected item for attachments.
Counter = 1
For Each objMsg In objSelection
  Set objAttachments = objMsg.Attachments
  lngCount = objAttachments.Count
  If lngCount = 0 Then
      Call MsgBox("The email message you have selected does not contain any attachments", vbCritical, "No attachments")
      Exit Sub
  End If
  If lngCount > 0 Then
      For i = lngCount To 2 Step -1
          'If objAttachments.Item(I).filename = "Handover Log Raw Data.xlsx" Then
          strFile = objAttachments.Item(i).filename
          ' Get the file name.
          strFile = objAttachments.Item(i).filename
          'check File name
          If Left(strFile, 8) = "Raw Data" Then
              ' Combine with the path to the Temp folder.
              strFile = strFolderPath & strFile
              ' Save the attachment as a file.
              objAttachments.Item(i).SaveAsFile strFile
              'path = ThisWorkbook.path & "\Handover Raw Files\" & strFile
              strFile = objAttachments.Item(i).filename
              TextBox4.Value = ThisWorkbook.Path & "\System Files\" & strFile
              'Set wb = Workbooks.Open(TextBox4.Text)
              Set wbA = ThisWorkbook
              FilePath = TextBox4.text
              Set wbB = Workbooks.Open(FilePath)
              With wbB
                  .Sheets("HandoverData").Range("B1").Copy wbA.Sheets("Handover Setup").Range("B9")
                  '350   .Sheets("HandoverData").Range("B2").Copy
                  DateText = .Sheets("HandoverData").Range("B2").Value
                  'MsgBox DateText
                  ThisWorkbook.Sheets("Handover Setup").Range("B10").Value = DateText
                  'ThisWorkbook.Sheets("Handover Setup").Range("B10").PasteSpecial xlPasteValues
                  'wbA.Sheets("Handover Setup").Range ("B10")
                  .Sheets("HandoverData").Range("B3").Copy wbA.Sheets("Handover Setup").Range("B11")
              End With
              TextBox1.Value = wbA.Sheets("Handover Setup").Range("B9").Value
              TextBox2.Value = wbA.Sheets("Handover Setup").Range("B10").text    'Value ' "mm/dd/yyyy") 'wbA.Sheets("Handover Setup").Range("B10").Text
              TextBox3.Value = wbA.Sheets("Handover Setup").Range("B11").Value
              Workbooks(Dir(FilePath)).Close
          Else
              Call MsgBox("The email you have selected does not contain a Handover file with raw data - please check and try again", vbCritical, "Message error")
              Exit Sub
          End If
          Counter = Counter + 1
      Next i
  End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
Application.ScreenUpdating = True

The procedure fails on the following lines;

Code:
Set objSelection = objOL.ActiveExplorer.Selection

It is then followed by an error 424 'Object required' on this line;

Code:
For Each objMsg In objSelection

Does anyone have a clue what's happening and why?
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Forum statistics

Threads
1,213,560
Messages
6,114,306
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top