sharky12345
Well-known Member
- Joined
- Aug 5, 2010
- Messages
- 3,422
- Office Version
- 2016
- Platform
- 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!
The procedure fails on the following lines;
It is then followed by an error 424 'Object required' on this line;
Does anyone have a clue what's happening and why?
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?