Hallo liebe Gemeinde,
vielleicht mal in der ruhigen Minute, komme nicht weiter! Das u.a. Script macht an der roten Stelle im debugger ein Meldefenster auf und haut mir auf die Finger!
Danke
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim rtitem As NotesRichtextItem
Dim currdoc As NotesDocument
Dim doc As NotesDocument
Dim docNew As NotesDocument
Dim db As NotesDatabase
Dim col As NotesDocumentCollection
Set dbCurrent = session.CurrentDatabase
'Zugriff auf Mail-DB des Users
Set dbMail = New NotesDatabase("","")
dbMail.OpenMail
If Not dbMail.IsOpen Then
Messagebox "Die Mail-Datenbank kann nicht geöffnet werden." + Chr$(10) + "Es können keine Mails importiert werden.", 16, "Vorgänge - Fehler"
Exit Sub
End If 'If Not dbMail.IsOpen Then
'Dialog zur Auswahl
Set col = ws.PickListCollection(1, False, dbMail.Server, dbMail.FilePath, "($Inbox)","Eingangsbox", "Markieren Sie die gewünschten Mails.")
If col.Count = 0 Then Exit Sub
'Abfrage ob Anhänge mit übernommen werden sollen
If Messagebox("Sollen eventuell vorhandene Dateianhänge mit übernommen werden?", 36, "Vorgänge") = 6 Then
intAttachment = 1 'Anhänge werden übernommen
Else
intAttachment = 0 'Anhäge werden nicht übernommen
End If 'If Messagebox("Sollen eventuell vorhandene Dateianhänge...
'Einfügen in Datenbank
Set docNew = docMail.CopyToDatabase(dbCurrent) ----> Meldung = Variant does not contain an object
Call docNew.ComputeWithForm(False, False)
If intAttachment = 0 Then 'Wenn Dateianhänge nicht übernommen werden sollen, werden sie hier gelöscht
If docNew.HasEmbedded Then
Set rtitem = docNew.GetFirstItem("Body")
If rtitem.Type = RICHTEXT Then
Forall objects In rtitem.EmbeddedObjects
If objects.Type = EMBED_ATTACHMENT Then
Call objects.Remove
End If 'If objects.Type = EMBED_ATTACHMENT
End Forall 'Forall objects In rtitem.EmbeddedObjects
End If 'If rtitem.Type = RICHTEXT
End If 'If refdoc.HasEmbedded
End If 'If intAttachment = 0 Then
Call docNew.Save(True,False)
End Sub
