Vba vba runtime error -1802485755(94904005) [duplicate] - excel

Question

This question already has answers here:
MailItem.GetInspector.WordEditor in Office 2016 generates Application-defined or object defined error
(4 answers)
Closed 3 months ago.
i have a strange problem, vba return me the error vba runtime error -1802485755(94904005) and i searched on internet and i found nothing, so i am tring to ask here if someone can help me
here is the code
Private Sub CommandButton3_Click()
Dim str As New Classe1
Dim ricerca As String
Dim dmi As outlook.MailItem
Dim UTCdate As Date, UTCdate2 As Date
Dim out As outlook.Application
Dim DATA1 As Date
Dim DATA2 As Date
Dim errorN As Long
On Error GoTo FormatoErrato:
DATA1 = DateAdd("h", 1, Res.DataStart.Value)
DATA2 = DateAdd("h", 23, Res.DataEnd.Value)
On Error GoTo 0
Set out = New outlook.Application
Set dmi = out.CreateItem(olMailItem)
UTCdate = dmi.PropertyAccessor.LocalTimeToUTC(DATA1)
UTCdate2 = dmi.PropertyAccessor.LocalTimeToUTC(DATA2)
ricerca = "#SQL=""urn:schemas:httpmail:subject"" LIKE '%sometext%'" & _
" AND ""urn:schemas:httpmail:datereceived"" <= '" & UTCdate2 & "'" & _
" AND ""urn:schemas:httpmail:datereceived"" >= '" & UTCdate & "'"
str.prova (ricerca)
FormatoErrato:
errorN = Err.Number
If errorN = 13 Then
MsgBox "invalid format", vbCritical
End If
End Sub
this code (in a class module) is on a userform button where you set two dates and then the following code search the emails that strike the requirments
Sub prova(val As String)
Res.Mezzi.Clear
Dim fol As outlook.Folder
Dim arr, arr2
Dim ricerca As String, txt As String
Dim n As Long, s As Long, tot As Long, l As Long
Dim mi As outlook.MailItem
Dim i As Object
Dim doc As Word.Document
Set fol = 'outlook folder path'
s = 0
n = 1
ReDim Preserve arr2(0 To s)
For Each i In fol.Items.Restrict(val)
If i.Class = olMail Then
Set mi = i
Set doc = mi.GetInspector.WordEditor
If doc.Tables.Count > 0 Then
For tot = 1 To doc.Tables.Count
arr2(s) = Application.WorksheetFunction.Clean(doc.Tables(tot).Cell(2, 2).Range.Text)
s = s + 1
ReDim Preserve arr2(0 To s)
Next tot
End If
End If
Next i
For s = 0 To UBound(arr2)
If IsEmpty(arr2(s)) = False And arr2(s) <> "" Then
Res.Mezzi.AddItem arr2(s)
End If
Next s
End Sub
the email that i'm looking for has a table, one or more in it so i used getinspector.wordeditor to check if the table exist and then take the data that i need from it.
the sub works fine if the difference between the dates is just few days if i put a week give that error
coudl you help me to solve the problem or work around it?
thanks in advance

Answer 1

I didn't find any information which Office version is installed on the system. So, if you have a pretty old version of MS Office installed the following case makes sense - the WordEditor property is only valid if the IsWordMail method returns True and the EditorType property is olEditorWord.
The most-likely possible reason for such errors at runtime is security settings when dealing with the Outlook object model. The message body is a protected property in the Outlook object model which can generate errors when Outlook is automated from an external application. You can find the list of protected properties described on the Protected Properties and Methods page.
So, the Object Model Guard warns users and prompts users for confirmation when untrusted applications attempt to use the object model to obtain email address information, store data outside of Outlook, execute certain actions, and send email messages. If, for any reason, the warning is not appropriate or can't be displayed, the Outlook object model may generate errors when accessing protected properties.
In your scenario you can:
Use a low-level API which doesn't trigger security issues in the Outlook object model - Extended MAPI or any other third-party wrapper around that API.
Create a COM add-in which has access to the trusted Application object and which doesn't trigger security issues.
Install any AV with the latest updates.
Use group policy settings to setup security settings to not trigger security issues.

Answer 2

after many trials i think i solved
to avoid to raise the error i should close the inspector.
in this way:
If i.Class = olMail Then
Set mi = i
Set insp = mi.GetInspector
Set doc = insp.WordEditor
If doc.Tables.Count > 0 Then
For tot = 1 To doc.Tables.Count
arr2(s) = Application.WorksheetFunction.Clean(doc.Tables(tot).Cell(2, 2).Range.Text)
s = s + 1
ReDim Preserve arr2(0 To s)
Next tot
End If
End If
insp.Close olSave
now all seems to work fine even with range of 10 days of emails