Fehler im Queryopendocument in der View

[skywook]

Hallo habe folgenden Fehler "Type mismatch" aber finde den Fehler nicht.

Ich möchte in der Forall-Schleife prüfen (mit notesEmbeddedObject.Type) was es für ein Anhangtyp das Dokument enthält:

- ein Dateianhang
- ein eingefügtes Bild
- oder Dokument ohne Anhang


Sub Queryopendocument(Source As Notesuiview, Continue As Variant)
   Dim docs As NotesDocumentCollection
   Dim doc As NotesDocument   
   Dim rtitem As NotesRichTextItem
   
   Dim obj As NotesEmbeddedObject
   Dim filename As String
   Dim res As Variant
   Dim aus As Integer
   Dim a As Integer
   
   Set docs = Source.Documents
   Set doc = docs.GetFirstDocument
   
   Set rtItem = doc.GetFirstItem("PBild")
   
   If Not rtItem Is Nothing Then
      If doc.HasEmbedded Then
                      Forall o In doc.EmbeddedObjects   =========>>> hier kommt der Fehler
            hier den Anhangtyp prüfen
         End Forall
         
   

[skywook]

Habs gefunden...

If Not Isempty....

ist die Lösung.

[LN4ever]

Hallo,

die folgende Funktion prüft, ob ein RT-item leer ist. Da findest du alle Einzelprüfungen

Function IsRTEmpty(UIDoc As NotesUIDocument, RTName As String)
   Dim Doc As NotesDocument
   Dim RTItem As NotesRichTextItem
   IsRTEmpty = True
   Set doc = uidoc.Document
   
   'Push RichText Field Changes to Back End
   Call uidoc.Refresh(True)
   
   Set RTItem = Doc.GetFirstItem(RTName)
   
   'Check For the presence of Text. If Found Exit Validation and display the text contents.
   Dim Text As String
   Text = RTItem.GetUnformattedText
   
   
   'Now Remove Spaces, Tabs, NewLines from the text and
   'check if there is any text remaining. If Yes, then it means
   'that the field has passed the validation check. Otherwise
   'be sure that there is no text present in the field, and check 
   'for the other possible contents i.e. Attachments etc...
   Dim NonWhiteText As Variant
   Dim Fr As String
   Fr={@replacesubstring("}+Text+{";@Char(9):@Char(10):@Char(13):@Char(32) ;"")}
   NonWhiteText = Evaluate(Fr)
   
   If NonWhiteText(0) <> "" Then
      'Means there are some Non White Space characters present in the field.
      IsRTEmpty = False
      Exit Function
   End If
   
   Dim Nav As NotesRichTextNavigator
   Set Nav = RTItem.CreateNavigator
   'Check for the presence of table
   If Nav.FindFirstElement(RTELEM_TYPE_TABLE ) Then
      IsRTEmpty = False
      Exit Function
   End If
   'Check for the presence of Doc Link/Db Link
   If Nav.FindFirstElement(RTELEM_TYPE_DOCLINK ) Then
      IsRTEmpty = False
      Exit Function
   End If
   'Check for the presence of File Attachment
   If Nav.FindFirstElement(RTELEM_TYPE_FILEATTACHMENT) Then
      IsRTEmpty = False
      Exit Function
   End If
   'Check for the presence of OLE Object
   If Nav.FindFirstElement(RTELEM_TYPE_OLE ) Then
      IsRTEmpty = False
      Exit Function
   End If
   'Check for the presence of Section
   If Nav.FindFirstElement(RTELEM_TYPE_SECTION ) Then
      IsRTEmpty = False
      Exit Function
   End If
   
   'Check For Pasted Images & Buttons
   Dim DXLExp As NotesDXLExporter
   Dim Parser As NotesDOMParser
   Dim MainNode As NotesDOMDocumentNode   
   Dim RTItems  As notesDOMNodeList
   Dim RTNode As NotesDOMElementNode
   Dim RTItemNode As NotesDOMElementNode
   Dim PictureList As NotesDOMNodeList
   Dim ButtonList As NotesDOMNodeList
   
   Dim j As Integer
   'Initialise Parser
   Set Parser=session.CreateDOMParser
   Set DXLExp = Session.CreateDXLExporter(Doc,Parser)
   DXLExp.Process
   
   Set MainNode = Parser.Document
   ' Get all Rich Text Fields
   Set RTItems = MainNode.GetElementsByTagName( "richtext" )
   
   For j = 1 To RTItems.NumberOfEntries
      Set  RTNode = RTItems.GetItem( j )
      Set RTItemNode = RTNode.ParentNode
      If Lcase(RTItemNode.GetAttribute("name")) = Lcase(RTName) Then
         'Search For Picture Node
         Set PictureList = RTItemNode.GetElementsByTagName("picture")
         If PictureList.NumberOfEntries > 0 Then
            IsRTEmpty = False
            Exit Function
         End If
         ‘Search for Buttons
         Set ButtonList = RTItemNode.GetElementsByTagName("button")
         If ButtonList.NumberOfEntries > 0 Then
            IsRTEmpty = False
            Exit Function
         End If
      End If
   Next
      
End Function

Gruß

Norbert