Link to home
Start Free TrialLog in
Avatar of jdpjtp910
jdpjtp910Flag for United States of America

asked on

VBA to open stationery in Lotus Notes

Ok,

Here is what I want to do. I want to ceate some code that will open a stationery in Lotus Notes and attach files. I then want the user to review the draft and press the send button within Lotus Notes. So I found some code that extracts information from the stationaries into cells. Is there any way to filter it by stationery name?

Here is the working code. It will gather all stationerys and give whatever field you want until the list is empty.

Sub get_stationary()
    Dim Maildb As Object, view As Object, Session As Object, entry As Object, entries As Object
    
    Sheets("Sheet2").Select
    counter = 2

    Set Session = CreateObject("Notes.NotesSession")

    Set Maildb = Session.GETDATABASE("", "")
    If Maildb.IsOpen = False Then
        Maildb.OpenMail
    End If

    Set view = Maildb.GetView("Stationery")
    Set entries = view.AllEntries
    
    If entries.Count = 0 Then
        Exit Sub
    End If
    
    Set entry = entries.GetFirstEntry
    
    Do Until entry Is Nothing
        With entry.Document
            Range("A" & counter) = Join(.getItemValue("entersendto"), ", ")
            Range("B" & counter) = Join(.getItemValue("entercopyto"), ", ")
            Range("C" & counter) = Join(.getItemValue("enterblindcopyto"), ", ")
            Range("D" & counter) = .getItemValue("subject")
            Range("E" & counter) = .getItemValue("body")
            Range("F" & counter) = .getItemValue("MailStationeryName")
        End With
        counter = counter + 1
        Set entry = entries.GetNextEntry(entry)
    Loop


    Set Maildb = Nothing
    Set Session = Nothing
End Sub

Open in new window


Now I tried to use IF statements to state if the stationery name IS NOT "TEST" then move to next. ELSE list the counters.

So basically two questions:

1. Can you use VBA to open a stationery in Lotus Notes and then attach files and wait for the user to press the send button?
OR if thats not possible:
2. Can you use my code and only extract what stationery name I want to see (test in the example)?
Avatar of jjphardy
jjphardy
Flag of United States of America image


You calling this from Excel?
How much of this is working? Is the body content legible in the spreadsheet? I would be supprised but it is possible depending on some Notes settings.
Much of this is written in the database design. How well do you know Notes Designer? If you look at the view for Stationary, it has an action called "New->Memo - Using Stationary." This has code that will allow you to select the stationary and create a memo using the stationary. The code is LotusScript but it is practaly VBA. Just creating the objects is different.
This mostly comes from that action in the mail template.
Dim session As New notessession
 Dim uiws As New notesuiworkspace
 Dim collection As notesdocumentcollection
 Dim noteUIEditDocument As notesuidocument
 Dim database As NotesDatabase
 Dim noteCursorDoc As NotesDocument
 Dim maildoc As NotesDocument
 Dim bodyitm As NotesRichTextItem
 Set uiws= CreateObject("Notes.NOTESUIWORKSPACE")

 Set noteCursorDoc = session.currentdatabase.createdocument
 Set database = session.currentdatabase
 
 Set collection = uiws.Picklistcollection(PICKLIST_CUSTOM, False, database.server, database.filepath, "Stationery", "Select Stationery", "Please select stationery for new memo.")
 If Not(collection Is Nothing) Then     '//User may have cancelled
  Set noteCursorDoc = collection.getfirstdocument
  If Not noteCursorDoc Is Nothing Then
   Set maildoc=   database.CreateDocument()
   Call notecursordoc.CopyAllItems (maildoc)
   
   maildoc.form="Memo"
   Set bodyItm=maildoc.GetFirstItem("body")
   Call bodyitm.EmbedObject(1454,"",filename)
   Set noteUIEditDocument =  uiws.Editdocument(False, noteCursorDoc)
  End If
 End If
 Exit Sub
End Sub
Untested code and I did not change the name of the objects to your code. You will need to do that and you will need to supply filename. The dims use notes types and objects but you can change them to juse object.
Oops.. The editdocument should edit the maildoc not the cursor doc.
  Set noteUIEditDocument =  uiws.Editdocument(False, maildoc)
 
Avatar of jdpjtp910

ASKER

I appreciate the code but I am having issues getting it into VBA form. I am not very familiar with Lotus Notes Designer. I think I found a work around to the problem though. I can basically import the stationery fields I want and then call them with my code. Only problem is there is over 300 stationery and my loop is slow. So, I have a pop up box that will prompt the user if they need to update the list for any changes (adding people to the TO field, or changing body format, etc).

Maybe you can help me with this question instead since the code is working?

If the stationery is not found, I want to have a drop box appear and have the user select the stationery by name and then reference that back to my code. I have the drop down box. I have a command button for the user to click. I need to know how to take the selection from the drop box and have excel activate that cell. Any ideas or should I start a new thread for that?
I missed a few of your questions, sorry about that.

All of the code is working fine.

The text is readable, but format is jacked up. But the fields are correctly. I am hiding that part from the user anyhow so I dont care about the format.

This is my first experience with Lotus Notes DB AT ALL.
Here is my code now:

'Code to Create Email
Sub LotusNotsSendActiveWorkbook()
'Send an e-mail & attachment using Lotus Not(s)
'Declare Variables for file and macro setup
Dim UserName As String, MailDbName As String, ccRecipient As String, attachment1 As String, bccRecipient As String
Dim Maildb As Object, maildoc As Object, AttachME As Object, session As Object
Dim EmbedObj1 As Object

'allow user to update stationery list if needed
Call Msgbox_Yes_No

With Application
.ScreenUpdating = False
.DisplayAlerts = False

' Open and locate current LOTUS NOTES User
Set session = CreateObject("Notes.NotesSession")
UserName = session.UserName
MailDbName = _
Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = session.GETDATABASE("", "")
If Maildb.IsOpen = True Then
Else
Maildb.OpenMail
End If

'find stationery
Range("F2").Select
Call looping

'Create New Mail and Address Title Handlers
Set maildoc = Maildb.CreateDocument
maildoc.form = "Memo"

'Set value for TO field
Recipient = ActiveCell.value
Selection.Offset(0, 1).Select
maildoc.Sendto = Recipient

'Set value for CC field
ccRecipient = ActiveCell.value
Selection.Offset(0, 1).Select
maildoc.CopyTo = ccRecipient

'Set value for BBC field
bccRecipient = ActiveCell.value
Selection.Offset(0, 1).Select
maildoc.enterblindcopyto = bccRecipient

'set value for subject field
maildoc.Subject = ActiveCell.value
Selection.Offset(0, 1).Select

'set value for body field
body = ActiveCell.value


' Select Workbook to Attach to E-Mail
maildoc.SaveMessageOnSend = True
attachment1 = "C:\test.xls"
If attachment1 <> "" Then
On Error Resume Next
Set AttachME = maildoc.CREATERICHTEXTITEM("attachment1")
Set EmbedObj1 = AttachME.EmbedObject(1454, "", attachment1)
On Error Resume Next
End If

attachment2 = "c:\test.bat"
If attachment2 <> "" Then
On Error Resume Next
Set AttachME = maildoc.CREATERICHTEXTITEM("attachment2")
Set EmbedObj1 = AttachME.EmbedObject(1454, "", attachment2)
On Error Resume Next
End If

'Displays email message without sending; user needs to click Send
Set workspace = CreateObject("Notes.NotesUIWorkspace")
Dim notesUIDoc As Object
    Set notesUIDoc = workspace.Editdocument(True, maildoc)
    Call notesUIDoc.GOTOFIELD("Body")
    Call notesUIDoc.FieldClear("Body")
    Call notesUIDoc.FieldAppendText("Body", body)

   


Set Maildb = Nothing
Set maildoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj1 = Nothing

.ScreenUpdating = True
.DisplayAlerts = True
End With

errorhandler1:

Set Maildb = Nothing
Set maildoc = Nothing
Set AttachME = Nothing
Set session = Nothing
Set EmbedObj1 = Nothing
End Sub

Sub Msgbox_Yes_No()
      Dim Response As Integer
      Dim Response2 As Integer

      ' Displays a message box with the yes and no options.
      Response = MsgBox(prompt:="Has the current stationery been updated? 'Yes' or 'No'.", Buttons:=vbYesNo)

      ' If statement to check if the yes button was selected.
      If Response = vbYes Then
      'Second message box to inform user that it will take one minute to update
      'gives user option to exit and perform later.
      MsgBox "It will take approximately one minute to update the list."
      Response2 = MsgBox(prompt:="Press 'Yes' to Contiune OR 'No' to exit.", Buttons:=vbYesNo)
      'if user wants to wait will update stationery
      If Response2 = vbYes Then
         Call get_stationary
      Else
      Exit Sub
      End If
      Else
         ' The no button was selected.
         Exit Sub
      End If


Sub looping()
'Loop to go through each cell and select which stationery for this worksheet
Do
'If statement to find stationery by name
If ActiveCell.value = "STATIONERY NAME" Then
'if found move to over 5 cells to get To field
Selection.Offset(0, -5).Select
Exit Sub
End If
'If not found move down next cell
ActiveCell.Offset(1, 0).Select
'Loop until at bottom of list
Loop Until IsEmpty(ActiveCell)

'If last cell is nothing display dropdown box so user can select stationery to use
If ActiveCell.value = "" Then
UserForm1.Show
End If

End Sub

Sub get_stationary()
    Dim Maildb As Object, view As Object, session As Object, entry As Object, entries As Object



   
    Sheets("Sheet2").Select
    counter = 2

    Set session = CreateObject("Notes.NotesSession")

    Set Maildb = session.GETDATABASE("", "")
    If Maildb.IsOpen = False Then
        Maildb.OpenMail
    End If

    Set view = Maildb.GetView("Stationery")
    Set entries = view.AllEntries
   
    If entries.Count = 0 Then
        Exit Sub
    End If
   
    Set entry = entries.GetFirstEntry
   
    Do Until entry Is Nothing
        With entry.Document
            Range("A" & counter) = Join(.getItemValue("entersendto"), ", ")
            Range("B" & counter) = Join(.getItemValue("entercopyto"), ", ")
            Range("C" & counter) = Join(.getItemValue("enterblindcopyto"), ", ")
            Range("D" & counter) = .getItemValue("subject")
            Range("E" & counter) = .getItemValue("body")
            Range("F" & counter) = .getItemValue("MailStationeryName")
        End With
        counter = counter + 1
        Set entry = entries.GetNextEntry(entry)
    Loop


    Set Maildb = Nothing
    Set session = Nothing


End Sub


When you say you import the stationary fields and import them.. is this to create a selection list for the user? If it is, the Picklist function may be a way to speed up the selection.
 Set collection = uiws.Picklistcollection(PICKLIST_CUSTOM, False, database.server, database.filepath, "Stationery", "Select Stationery", "Please select stationery for new memo.")
If Not(collection Is Nothing) Then     '//User may have cancelled
 Set noteCursorDoc = collection.getfirstdocument
 If noteCursorDoc Is Nothing Then
exit sub
 End If
 End If
 At this point noteCursorDoc is a document the user selected.
If this is not what you want, there are a few ways to spead up your code.
get the notesdocument out of the entry object.
set stationDoc=entry.document.
Calling it from the entry object is a hog.
You could also use getfirst and next document from the notesview.
 Set stationDoc=view.GetFirstDocument()
 Set stationDoc=view.GetNextDocument(stationdoc)
Instead of getnextentry from allentries. It should be faster but will not be sorted.
When I say import, I am taking about my get_stationery code. That code will return all the stationerys from Lotus and place them in sheet 2 in their respective cell range in Excel.

The drop down list is IF the stationery is not found in that list from the Loop code. So my dropdown list is set to equal all values in the Range column F. So the user can then select a stationery name to use. I want this incase a stationery name was renamed and no longer found but the static name in the excel workbook.
ASKER CERTIFIED SOLUTION
Avatar of jjphardy
jjphardy
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Sounds good. I will have to play with the picklistcollection and see if I can get it working. Thanks for the help :).