How to export a Notes Attachment which is not in the body by using VBA

Question

I hope some of you can help with the code under these text, I can export Attachments which are in the body of an Lotus Notes Mail, but also I need to export them, when they aren't in the body (like "normal" attachments).

Set LNItem = doc.GETFIRSTITEM("Body")

If doc.HasEmbedded Then

    int_Anhang = 1
    x = 0
    Worksheets("Mails").Cells(j, 3).Value = 0

    On Error Resume Next

    For Each LNAttachment In LNItem.EmbeddedObjects

        y = 0

        AttPath = ActiveWorkbook.path & "1-Weiterleitung_Mail-Anhang" & y & "-" + LNAttachment.Name

        While Dir(AttPath) <> ""

            y = y + 1

            AttPath = ActiveWorkbook.path & "1-Weiterleitung_Mail-Anhang" & y & "-" + LNAttachment.Name

        Wend

        LNAttachment.ExtractFile (AttPath)
        Worksheets("Mails").Cells(j, 3).Value = Worksheets("Mails").Cells(j, 3).Value + 1
        Worksheets("Mails").Cells(j, 7 + x).Value = y & "-" + LNAttachment.Name

        x = x + 1

    Next

    On Error GoTo Fehler

    Debug.Print vbNewLine

End If

Can someone help? My Question in other communities:

ms-office-forum.net

Herber.de

Here are more code:

Dim sess As Object, db As Object, folder As Object, dc As Object, docMemo As Object, docNext As Object, LNItem As Object
Dim memoSenders As Variant, memoAnhang As Variant, memoInhalt As Variant, memoLayout As Variant, LNAttachment As Variant
Dim memoDate As Date, todayDate As Date
Dim mail_Server As String, mail_Datei As String, memoSubject As String, AttPath As String
Dim y As Integer, int_test As Integer

'On Error GoTo Fehler_Notes
On Error GoTo Fehler

Set sess = CreateObject("Notes.NotesSession")
'sess.Initialize ("")

'On Error GoTo Fehler

mail_Server = Worksheets("Daten").Cells(2, 2).Value
mail_Datei = Worksheets("Daten").Cells(2, 3).Value

'Open the mail database in notes
Set db = sess.GetDatabase(mail_Server, mail_Datei)

If db.IsOpen = True Then

    'Already open for mail

Else

    db.OPENMAIL

End If

int_test = 0

Do While Worksheets("Daten").Cells(i, 6).Value <> ""

    Set folder = db.GetView(Worksheets("Daten").Cells(i, 6).Value)

    If Worksheets("Daten").Cells(i, 9).Value <> "" Then

        todayDate = Worksheets("Daten").Cells(i, 9).Value

    Else

        Worksheets("Daten").Cells(i, 9).Value = "01.01.2000 00:00"
        todayDate = Worksheets("Daten").Cells(i, 9).Value

    End If

    Set doc = folder.GetFirstDocument

    Do Until doc Is Nothing

        Set docNext = folder.GetNextDocument(doc)

        'Datum des Empfangs
        Worksheets("Daten").Cells(29, 2).Value = doc.GetItemValue("DeliveredDate")
        memoDate = Worksheets("Daten").Cells(29, 2).Value

        int_test = int_test + 1
        int_xxx = int_xxx + 1

        memoSenders = doc.GetItemValue("From")
        memoInhalt = doc.GetItemValue("Body")
        memoLayout = doc.GetItemValue("Form")
        memoSubject = doc.GetItemValue("Subject")(0)

        Worksheets("Mails").Cells(j, 1).Value = i - 2
        Worksheets("Mails").Cells(j, 2).Value = memoSenders
        Worksheets("Mails").Cells(j, 4).Value = memoInhalt
        Worksheets("Mails").Cells(j, 5).Value = memoLayout
        Worksheets("Mails").Cells(j, 6).Value = memoSubject

        'Prüfen ob Attachments innerhalb der Mail vorhanden sind
        Set LNItem = doc.GETFIRSTITEM("Body")

        If doc.HasEmbedded Then

            int_Anhang = 1
            x = 0
            Worksheets("Mails").Cells(j, 3).Value = 0

            On Error Resume Next

            For Each LNAttachment In doc.EmbeddedObjects

                y = 0

                AttPath = ActiveWorkbook.path & "\01-Weiterleitung_Mail-Anhang\" & y & "-" + LNAttachment.Name

                While Dir(AttPath) <> ""

                    y = y + 1

                    AttPath = ActiveWorkbook.path & "\01-Weiterleitung_Mail-Anhang\" & y & "-" + LNAttachment.Name

                Wend

                LNAttachment.ExtractFile (AttPath)
                Worksheets("Mails").Cells(j, 3).Value = Worksheets("Mails").Cells(j, 3).Value + 1
                Worksheets("Mails").Cells(j, 7 + x).Value = y & "-" + LNAttachment.Name

                x = x + 1

            Next

            On Error GoTo Fehler

            Debug.Print vbNewLine

        End If

        Call doc.PutInFolder(Worksheets("Daten").Cells(6, 3).Value)

        Call doc.MarkRead

        Call doc.RemoveFromFolder(Worksheets("Daten").Cells(i, 6).Value)

        j = j + 1

        Set doc = docNext

    Loop

    Worksheets("Daten").Cells(i, 9).Value = CStr(Format(Now, "MM/DD/YYYY hh:mm"))

    i = i + 1

Loop

If int_test <> 0 Then

    i = 3

    ReadNotesEmail i, j

End If

int_error = 0

Exit Sub

Regards

Answer 1

check for File name and you can get the embededobject

this is the java code:

    String path="";
    Vector fileName= session.evaluate("@AttachmentNames", document);

    for (int i = 0; i < fileName.size(); i++) {
     EmbeddedObject embeddedObject = 
     document.getAttachment(fileName.get(i));
     embeddedObject .extractFile(path+fileName.get(i));
    }

Answer 2

I've try to make the code from Duston work in Excel VBA:

Set Item = Doc.GetFirstItem("$file")

            If LCase(Item.Name) = "$file" Then

                Set FileItem = Item
                FileName = FileItem.Values(0)
                Set Object = Doc.GetAttachment(FileName)
                AttPath = ActiveWorkbook.path & "\01-Weiterleitung_Mail-Anhang\" & "1" & "-"

                ' extract the file ..
                Call Object.ExtractFile(AttPath & FileName)

            End If

My code produce no error and the script goes into the If-Case, but nothing happens. (The "Filename" is empty)

Answer 3

Also check for items named $File. Some sample code is located in this link: http://www.richardcivil.net/archives/157

In particular:

If Lcase( item.Name ) = "$file" Then

            ' get the filename ...
            Set FileItem = Item
            FileName = FileItem.Values(0)
            Set Object = sourceDoc.GetAttachment( FileName ) 

            ' extract the file ..
            Call object.ExtractFile( tempDir & FileName )

            ' upload the file ..
            Set newObject = attachmentBody.EmbedObject( object.Type, "", tempDir & FileName )

            ' kill the file ..
            Kill tempDir & FileName

        End If

Answer 4

NotesDocument has also a property EmbeddedObjects.

You can use it this way:

    For Each LNAttachment In doc.EmbeddedObjects
        ...
    Next