VBA to Detach Excel File from Lotus Notes

[JeepChick]

I have an Excel spreadsheet that generates a Lotus Notes email with an excel spreadsheet attached. That spreadsheet gets sent out to a bunch of people, who generate Lotus Notes back to me with the excel attachments. My Access database would like to read through those emails in my Inbox and strip off the attached excel files into a directory on my C:\ drive. I have code that should work, but it's not recognizing the message type of the Lotus Notes as RICHTEXTFORMAT. See code and note below.

CODE TO DETACH EXCEL ATTACHMENT FROM LOTUS EMAIL

Sub Get_EMAIL_Attachment()

Dim View As Object
Dim nDoc As Object
Dim itm As Variant
Dim ITM1 As Variant
Dim attachment As NotesEmbeddedObject
Const RICHTEXT = 1
Const EMBED_ATTACHMENT = 1454
Const sPathToSave = "C:\EMAIL_EXTRACTS\"
Set s = CreateObject("Notes.Notessession") 'create notes session
Set db = s.GetDatabase("", "") 'Orwell", "Mail\CS\Repoteam.nsf") 'set db to database not yet named
Call db.openmail
Set View = db.GetView("($Inbox)")
Set nDoc = View.GetFirstDocument
While Not (nDoc Is Nothing)
If nDoc.HasEmbedded Then
Set itm = nDoc.GetFirstItem("Body")

' The following line is where I'm having a problem. The itm.Type for RICHTEXT IS "1", but
' my itm.Type for my attachment is "1280" and it skips over the detach logic...help!

If itm.Type = RICHTEXT Then
Dim attch As Variant
For Each attch In itm.EmbeddedObjects
If (attch.Type = EMBED_ATTACHMENT) Then
attch.ExtractFile sPathToSave & attch.Name
End If
Next
End If
End If
Set nDoc = View.GetNextDocument(nDoc)
Wend

MsgBox "Email search completed."

End Sub

 

[Norie]

Could the problem be that the attachments aren't of type RichText?

If you know that the value of Type is for the attachments why not use it instead of the RICHTEXT constant?

 

[JeepChick]

Yes, I think the problem is that the excel attachment isn't of RICHTEXT format. I did try coding for the TEXT constant but it didn't work...it erred out after the IF statement where I originally encountered the problem.

 

[Norie]

I thought you knew the value for the constant you want - 1208 or whatever.

Why not use that in the If?

Or you might want to look at what other properties attachments can have.

Oh and I just noticed something - you are using GetFirstItem to retrieve the body of the document.

Does the document object not have some property/collection that you can use to refer to any attachments it may have?

PS I've not done anything with LotusNotes recently so I'm a bit rusty - these are only suggestions.

 

[brettville]

How To Download Attachments From Domino Lotus Notes Excel VBA COM OLE

For anyone new looking to do this: (The commented out code uses the type library objects, the non commented code uses pure objects.. and also doesn't require the user to log in or provide a password)

    'Dim NS As New NotesSession
    'Dim NDB As NotesDatabase
    'Dim NV As NotesView
    'Dim ND As NotesDocument
    'Dim NI As NotesItem
    'Dim EO As NotesEmbeddedObject
    Dim NS As Object
    Dim NDB As Object
    Dim NV As Object
    Dim ND As Object
    Dim NI As Object
    Dim EO As Object
    Dim aItems As Variant
    Dim iThisItem As Integer
    Dim aValues As Variant
    Set NS = CreateObject("Notes.NotesSession")
    'NS.Initialize "YOUR PASSWORD"
    'Set NDB = NS.GetDatabase("SERVER", "mail\USERNAME")
    Set NDB = NS.GetDatabase("", "")
    'If NDB.IsOpen = False Then NDB.Open
    If NDB.IsOpen = False Then NDB.Openmail
    Set NV = NDB.GetView("($Inbox)")
    Set ND = NV.GetFirstDocument
    'Dim FSO As New FileSystemObject
    Do
        aItems = CVar(ND.Items)
        For iThisItem = 0 To UBound(aItems)
            Set NI = aItems(iThisItem)
            'If NI = "$FILE" Then
            If NI.Name = "$FILE" Then
                aValues = CVar(NI.Values)
                Debug.Print "From: " & ND.GetFirstItem("From").Text
                Debug.Print "Subject: " & ND.GetFirstItem("Subject").Text
                Debug.Print "File: " & aValues(0)
                Set EO = ND.GetAttachment(aValues(0))
                EO.ExtractFile "c:\" & aValues(0)
                'Debug.Print "Success: " & FSO.FileExists("c:\" & aValues(0))
                Debug.Print "----------------------------------------------------------"
            End If
        Next iThisItem
        If IsEmpty(NV.GetNextDocument(ND)) Then Exit Do
        Set ND = NV.GetNextDocument(ND)
        DoEvents
    Loop