We help IT Professionals succeed at work.

Excel attachment via Lotus Notes

c_elfman
c_elfman used Ask the Experts™
on
I have been able to create an email in Lotus Notes from Excel and populate the body with specific fields.  However, I need to be able to attach the temporary workbook, coded as "saAttachment" in the email as well.   I cannot get that piece to work.

What am I doing wrong?   That is the only piece that isn't working...and I need it for a new process implementation in my department.

Any assistance is greatly appreciated.

Here is the code I am using:


Sub Send_Excel_Attachment_To_Lotus_Notes()
 
Dim Notes As Object  'The Notes session
Dim db As Object  'The mail database
Dim WorkSpace As Object  'The mail document itself
Dim uidoc As Object
Dim UserName As String   'The current users notes names
Dim MailDbName As String   'The current users notes mail database name
Dim stFile As String
Dim stfilename As String
Dim saAttachment As String
Dim saPath As String    'Temporary file location
Dim saFilename As String     'Temporary filename for attachment


'Set up the user copy of the PO request
stfilename = Environ("username") & Format$([B8], " MM-DD-YYYY") & " PO Request"
stFile = "C:\Documents and Settings\" & Environ("username") & "\Desktop\" & stfilename & ".xls"
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveSheet.Buttons.Delete
ActiveSheet.Range("A1:H300").Validation.Delete
ActiveSheet.Range("E24").Value = Range("e24").Value
ActiveSheet.Range("B8").Value = Range("B8").Value

    count = count + 1
If count = 0 Then
        ActiveWorkbook.SaveAs stFile
ElseIf count > 0 And Dir(stFile & " v" & count - 1 & ".xls") = "" Then
        ActiveWorkbook.SaveAs (stFile & " v" & count & ".xls")
End If

ActiveWorkbook.Close False


'Create and close the temporary file for the attachment
saPath = "C:\Documents and Settings\" & Environ("username") & "\Desktop\"
saFilename = Environ("username") & "." & Format$([B8], "MM-DD-YYYY") & ".PO Request"
'saFile = saPath & saFilename & ".xls"
saAttachment = saPath & saFilename & ".xls"
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveSheet.Buttons.Delete
ActiveSheet.Range("A1:H300").Validation.Delete
ActiveSheet.Range("E24").Value = Range("e24").Value
ActiveSheet.Range("B8").Value = Range("B8").Value
ActiveWorkbook.SaveAs saAttachment
ActiveWorkbook.Close False


'This is the code to create the email and populate the body with specific information

Set Notes = CreateObject("Notes.NotesSession")
UserName = Notes.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set db = Notes.GETDATABASE(vbNullString, MailDbName)
Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
Call WorkSpace.ComposeDocument(, , "Memo")
Set uidoc = WorkSpace.CurrentDocument
 


'If cells are null, such as email address, cc, etc, then ignore and dont paste into email
On Error Resume Next
 
'Recipient information
Recipient = "Email Address Goes Here"
Call uidoc.FieldSetText("EnterSendTo", Recipient)

 
'Copy the subject from cell C1 into the SUBJECT: field in Lotus Notes
Subject1 = Sheets("Sheet2").Range("C1").Value
Call uidoc.FieldSetText("Subject", Subject1)
 
 
'Copy the cells in the range (one column going down) into the BODY in Lotus Notes.
Call uidoc.GotoField("Body")
Body1 = Sheets("Sheet2").Range("C8").Value 'This field is for the Requestor Name
Body2 = Sheets("Sheet2").Range("C9").Value 'This field is for the Requestor phone number
Body3 = Sheets("Sheet2").Range("C7").Value 'This field is for the date of the PO Request
Body4 = Sheets("Sheet2").Range("C18").Value 'This field for the manager approval
Body5 = Sheets("Sheet2").Range("C17").Value 'This field is the reason for the PO
Body6 = Sheets("Sheet2").Range("C10").Value 'This field is for the Account GL
Body7 = Sheets("Sheet2").Range("C11").Value 'This field is for the Cost Center
Body8 = Sheets("Sheet2").Range("C12").Value 'This field is for the FMD
Body9 = Sheets("Sheet2").Range("C13").Value 'This field is for the Line Number assignments
Body10 = Sheets("Sheet2").Range("C14").Value 'This field is for the Category
Body11 = Sheets("Sheet2").Range("C16").Value 'This field is for the name of the vendor
Body12 = Sheets("Sheet2").Range("C15").Value 'This field text stating PO Amount

'Pull the information in and add the carriage returns to post the data
Call uidoc.InsertText(Body1 & vbCrLf)
Call uidoc.InsertText(Body2 & vbCrLf)
Call uidoc.InsertText(Body3 & vbCrLf)
Call uidoc.InsertText(Body4 & vbCrLf)
Call uidoc.InsertText(Body5 & vbCrLf & vbCrLf & vbCrLf)
Call uidoc.InsertText(Body6 & vbCrLf)
Call uidoc.InsertText(Body7 & vbCrLf)
Call uidoc.InsertText(Body8 & vbCrLf)
Call uidoc.InsertText(Body9 & vbCrLf)
Call uidoc.InsertText(Body10 & vbCrLf)
Call uidoc.InsertText(Body11 & vbCrLf)
Call uidoc.InsertText(Body12 & vbCrLf & vbCrLf)

'Insert some carriage returns at the end of the email
Call uidoc.InsertText(vbCrLf & vbCrLf)


Application.CutCopyMode = False


Set uidoc = Nothing: Set WorkSpace = Nothing
Set db = Nothing: Set Notes = Nothing

YesNo = MsgBox("Do you want to create another PO?", vbYesNo + vbQuestion)
Select Case YesNo
Case vbYes
'Call CreateResetButton
Call DataValReset
    MsgBox Title:="Reminder", Prompt:="Please attach a copy of the PO Request spreadsheet and your quote to the email." & Chr(10) & Chr(10) & "The PO Request file is located on the desktop as " & stfilename & ".xls", Buttons:=64
Case vbNo
    MsgBox Title:="Reminder", Prompt:="Please attach a copy of the PO Request spreadsheet and your quote to the email." & Chr(10) & Chr(10) & "The PO Request file is located on the desktop as " & stfilename & ".xls", Buttons:=64
    Application.DisplayAlerts = False
    ThisWorkbook.ChangeFileAccess xlReadOnly
    Kill ThisWorkbook.FullName
    ThisWorkbook.Close False

End Select


End Sub
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Sjef BosmanGroupware Consultant

Commented:
You might pull this off using
      Call uidoc.Import(saAttachment)
while in the Body field.

If that doesn't work, there is the SendKeys library. You can use it to simulate keystrokes to open the Attach File dialog box.

If that neither of the two works, you have to (re)write some of it using back-end objects:
      Set doc= uidoc.Document
      Set attachment= New NotesRichTextItem(body, "attachment")
      Call attachment.EmbedOnject(1454,,saAttachment)

but this is not guaranteed to work, there are some serious pitfalls.

By far the best way is to rewrite everything, to use only back-end documents.

Author

Commented:
Thank you for the suggestion.  I tried that and it gave me an error "Import/Export not configured".
Groupware Consultant
Commented:
What versions of Excel and Notes are you using? If Excel is too new and you didn't upgrade Notes, your import won't work.

Maybe you have to add a line to your notes.ini file, see here for suggestions:
http://www-10.lotus.com/ldd/nd6forum.nsf/DateAllFlatweb/6a4ef8487cc94afc852575450040d2f7?OpenDocument

Author

Commented:
Notes 8.5.2
Excel 2007
Sjef BosmanGroupware Consultant

Commented:
Hmmm, strange. Anyway, I don't think the Import would have worked, as it serves to import data and not a complete file.

Here are the details on how to attach a file, by the master:
http://www-10.lotus.com/ldd/bpmpblog.nsf/dx/attaching-LS

Author

Commented:
Okay - I have played around with the code a little more and got it to attach the document.  However, now the special fields that used to appear in the body before the signature are now listed below the signature.

I am sure I have something in the wrong spot but I cannot find it.


Sub Send_Excel_Attachment_To_Lotus_Notes()
 
Dim Session As Object  'The Notes session
Dim Maildb As Object  'The mail database
Dim WorkSpace As Object  'The mail document itself
Set WorkSpace = CreateObject("Notes.NotesUIWorkSpace")
Dim uidoc As Object
Dim UserName As String   'The current users notes names
Dim MailDbName As String   'The current users notes mail database name
Dim stFile As String
Dim stFileName As String
Dim saAttachment As String
Dim stPath As String    'Temporary file location
Dim saFilename As String     'Temporary filename for attachment
Dim saPath As String    'Temporary file location

'These are new variables
Dim MailDoc As Object
Dim EmbedObj1 As Object
Dim attachME As Object
Dim Recipient As String
Dim Subject As String
Dim bodytext As Variant

Dim Body1 As Variant
Dim Body2 As Variant
Dim Body3 As Variant
Dim Body4 As Variant
Dim Body5 As Variant
Dim Body6 As Variant
Dim Body7 As Variant
Dim Body8 As Variant
Dim Body9 As Variant
Dim Body10 As Variant
Dim Body11 As Variant
Dim Body12 As Variant




'Set up the user copy of the PO request
stPath = "C:\Documents and Settings\" & Environ("username") & "\Desktop\"
stFileName = Environ("username") & Format$([B8], " MM-DD-YYYY") & " PO Request"
stFile = "C:\Documents and Settings\" & Environ("username") & "\Desktop\" & stFileName & ".xls"
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveSheet.Buttons.Delete
ActiveSheet.Range("A1:H300").Validation.Delete
ActiveSheet.Range("E24").Value = Range("e24").Value
ActiveSheet.Range("B8").Value = Range("B8").Value
'ActiveWorkbook.SaveAs stFile

If Dir(stFile) = "" Then
        ActiveWorkbook.SaveAs stFile
ElseIf Dir(stPath & stFileName & " v1" & ".xls") = "" Then
  ActiveWorkbook.SaveAs (stPath & stFileName & " v1.xls")
ElseIf Dir(stPath & stFileName & " v2" & ".xls") = "" Then
  ActiveWorkbook.SaveAs (stPath & stFileName & " v2.xls")
End If
ActiveWorkbook.Close False



Application.DisplayAlerts = False
'Create, save and close the temporary file for attachment
With ActiveSheet
    .Copy
    .Buttons.Delete
    .Range("A1:H300").Validation.Delete
    .Range("E24").Value = Range("e24").Value
    .Range("B8").Value = Range("B8").Value
    saPath = "C:\Documents and Settings\" & Environ("username") & "\Desktop\"
    saFilename = Environ("username") & "." & Format$([B8], "MM-DD-YYYY") & ".PO Request"
End With

saAttachment = saPath & saFilename & ".xls"

With ActiveWorkbook
    .SaveAs saAttachment
    .Close False
End With


Recipient = "Enter Email Address Here"
Subject = Sheets("Sheet2").Range("C1").Value
Body1 = Sheets("Sheet2").Range("C8").Value 'This field is for the Requestor Name
Body2 = Sheets("Sheet2").Range("C9").Value 'This field is for the Requestor phone number
Body3 = Sheets("Sheet2").Range("C7").Value 'This field is for the date of the PO Request
Body4 = Sheets("Sheet2").Range("C18").Value 'This field for the manager approval
Body5 = Sheets("Sheet2").Range("C17").Value 'This field is the reason for the PO
Body6 = Sheets("Sheet2").Range("C10").Value 'This field is for the Account GL
Body7 = Sheets("Sheet2").Range("C11").Value 'This field is for the Cost Center
Body8 = Sheets("Sheet2").Range("C12").Value 'This field is for the FMD
Body9 = Sheets("Sheet2").Range("C13").Value 'This field is for the Line Number assignments
Body10 = Sheets("Sheet2").Range("C14").Value 'This field is for the Category
Body11 = Sheets("Sheet2").Range("C16").Value 'This field is for the name of the vendor
Body12 = Sheets("Sheet2").Range("C15").Value 'This field text stating PO Amount

bodytext = Body1 & vbCrLf & Body2 & vbCrLf & Body3 & vbCrLf & Body4 & vbCrLf & Body5 & vbCrLf & vbCrLf & vbCrLf & Body6 & vbCrLf & Body7 & vbCrLf & Body8 & vbCrLf & Body9 & vbCrLf & Body10 & vbCrLf & Body11 & vbCrLf & Body12 & vbCrLf & vbCrLf

'This is the code to create the Notes Session
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE(vbNullString, MailDbName)
If Maildb.IsOpen <> True Then
    On Error Resume Next
    Maildb.OPENMAIL
End If
Set MailDoc = Maildb.CreateDocument
MailDoc.Form = "Memo"


With MailDoc
    .SendTo = Recipient
    .Subject = Subject
    .Body = bodytext
    .SaveMessageOnSend = False
End With


'Create the attachment
If saAttachment <> "" Then
    Set attachME = MailDoc.CreateRichTextItem("saAttachment")
    Set EmbedObj1 = attachME.EmbedObject(1454, "", saAttachment, "Attachment")
    MailDoc.CreateRichTextItem ("Attachment")
End If
   
Set WorkSpace = CreateObject("Notes.NotesUIWorkSpace")
Set MailDoc = WorkSpace.EDITDocument(True, MailDoc)
   
With MailDoc
    .GotoField ("Body")
End With


Application.CutCopyMode = False

'save message
MailDoc.SaveMessageOnSend = True

With MailDoc
    .PostedDate = Now()
End With

Set uidoc = Nothing: Set WorkSpace = Nothing
Set db = Nothing: Set Notes = Nothing

YesNo = MsgBox("Do you want to create another PO?", vbYesNo + vbQuestion)
Select Case YesNo
Case vbYes
Call DataValReset
    MsgBox Title:="Reminder", Prompt:="Please attach a copy of the PO Request spreadsheet and your quote to the email." & Chr(10) & Chr(10) & "The PO Request file is located on the desktop as " & stFileName & ".xls", Buttons:=64
Case vbNo
    MsgBox Title:="Reminder", Prompt:="Please attach a copy of the PO Request spreadsheet and your quote to the email." & Chr(10) & Chr(10) & "The PO Request file is located on the desktop as " & stFileName & ".xls", Buttons:=64
    Application.DisplayAlerts = False
   'ThisWorkbook.ChangeFileAccess xlReadOnly
   ' Kill ThisWorkbook.FullName
    ThisWorkbook.Close False

End Select

'Kill saAttachment
End Sub
Sjef BosmanGroupware Consultant
Commented:
The only thing that's not entirely right is the line indicated with <----- below. As far as I can see it serves no purpose.

'Create the attachment
If saAttachment <> "" Then
    Set attachME = MailDoc.CreateRichTextItem("saAttachment")
    Set EmbedObj1 = attachME.EmbedObject(1454, "", saAttachment, "Attachment")
    MailDoc.CreateRichTextItem ("Attachment")  <-----
End If

I'm afraid that you can't do better than this. The attachment is in a separate field, and not in the Body-field. That's why it is listed at the bottom. AFAIK there is no easy way to correct that.

Commented:
Rather than just adding to the body you should make a rich text body and then you can embed the sheet where you want:

Have a look at my Excel sheet here.  In the VBA code (ALT-F11) there is a "Sub SendNotesEmail" which creates a notes email, rich text body and sends itself.

http://scripts.dragon-it.co.uk/links/lotus-notes-export-to-excel

e.g. this puts the text from the field "body", some blank lines, attachment then some more text..... you can add formatting easily to the rich text field too if you want to make it look a little fancier...

Rem "Setup Body of message"
    Set notesrtf = notesdoc.CREATERICHTEXTITEM("body")
        notesrtf.AppendText body
        notesrtf.ADDNEWLINE 2
    Call notesrtf.EMBEDOBJECT(1454, "", ThisDocument.Path & "\" & ThisDocument.Name)
        notesrtf.ADDNEWLINE 2
        notesrtf.AppendText "Assist2 login: " & Environ$("USERNAME")
        notesrtf.ADDNEWLINE 1
        notesrtf.AppendText "Notes name : " & notessession.commonusername
               
Steve

Commented:
BTW also you can do instead of this

Subject = Sheets("Sheet2").Range("C1").Value

Subject = Range("Sheets2!C1").Value
or Subject = Range("Sheets2!C1").Text
or Subject = Range("Sheets2!C1")

Steve