Ich habe folgenden Code, der sogar funktioniert. Aber aus irgend einen seltsamen Grund brauche ich die Zeile "Set doc = DB.GETDOCUMENTBYUNID(UID)" doppelt, da ich sonst in einen Automatisierungsfehler laufe.
Sub Attach2Notes()
Const Fieldname As String = "fd_wrdAttachment"
Dim uiws As NOTESUIWORKSPACE
Dim uidoc As NOTESUIDOCUMENT
Dim doc As NOTESDOCUMENT
Dim DB As NOTESDATABASE
Dim rtitem As NOTESRICHTEXTITEM
Dim strTempFileName As String
Dim UID As String
Dim x As Long
Set uiws = CreateObject("Notes.NotesUIWorkspace")
Set uidoc = uiws.CURRENTDOCUMENT
If Not uidoc Is Nothing Then
If ActiveDocument.Path = "" Then
MsgBox "Dokument noch nicht gespeichert!", vbCritical + vbOKOnly
Else
If uidoc.CURRENTFIELD = Fieldname Then
If MsgBox("Für diese Aktion muss das aktuelle Notes Dokument gespeichert werden, jetzt speichern?", vbInformation + vbOKCancel) = vbOK Then
uidoc.Save
Set DB = uidoc.Document.PARENTDATABASE
UID = uidoc.Document.UNIVERSALID
Set doc = DB.GETDOCUMENTBYUNID(UID)
doc.REPLACEITEMVALUE "SaveOptions", "0"
strTempFileName = Environ("TEMP") & Application.PathSeparator & ActiveDocument.name
ActiveDocument.SaveAs strTempFileName
If doc.HASITEM(Fieldname) Then
doc.RemoveItem Fieldname
End If
Set rtitem = doc.CREATERICHTEXTITEM(Fieldname)
rtitem.EMBEDOBJECT 1454, "", strTempFileName
doc.Save True, True
uidoc.Close
Set doc = DB.GETDOCUMENTBYUNID(UID)
Set doc = DB.GETDOCUMENTBYUNID(UID)
doc.RemoveItem "SaveOptions"
uiws.EDITDOCUMENT True, doc
End If
Else
MsgBox uidoc.CURRENTFIELD
MsgBox "Cursor muss auf Feld fd_wrdAttachment stehen!"
End If
End If
Else
MsgBox "Kein Dokument in Notes geöffnet!"
End If
End Sub
Jemand eine Idee was da schief geht und wie man es elegant fixen kann?
Gruss
Remo