jdpjtp910
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.
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)?
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
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)?
Oops.. The editdocument should edit the maildoc not the cursor doc.
Set noteUIEditDocument = uiws.Editdocument(False, maildoc)
Set noteUIEditDocument = uiws.Editdocument(False, maildoc)
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?
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?
ASKER
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.
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.
ASKER
Here is my code now:
'Code to Create Email
Sub LotusNotsSendActiveWorkboo k()
'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.NotesS ession")
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 ("attachme nt1")
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 ("attachme nt2")
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.NotesU IWorkspace ")
Dim notesUIDoc As Object
Set notesUIDoc = workspace.Editdocument(Tru e, maildoc)
Call notesUIDoc.GOTOFIELD("Body ")
Call notesUIDoc.FieldClear("Bod y")
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.NotesS ession")
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("enters endto"), ", ")
Range("B" & counter) = Join(.getItemValue("enterc opyto"), ", ")
Range("C" & counter) = Join(.getItemValue("enterb lindcopyto "), ", ")
Range("D" & counter) = .getItemValue("subject")
Range("E" & counter) = .getItemValue("body")
Range("F" & counter) = .getItemValue("MailStation eryName")
End With
counter = counter + 1
Set entry = entries.GetNextEntry(entry )
Loop
Set Maildb = Nothing
Set session = Nothing
End Sub
'Code to Create Email
Sub LotusNotsSendActiveWorkboo
'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.NotesS
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
Set EmbedObj1 = AttachME.EmbedObject(1454,
On Error Resume Next
End If
attachment2 = "c:\test.bat"
If attachment2 <> "" Then
On Error Resume Next
Set AttachME = maildoc.CREATERICHTEXTITEM
Set EmbedObj1 = AttachME.EmbedObject(1454,
On Error Resume Next
End If
'Displays email message without sending; user needs to click Send
Set workspace = CreateObject("Notes.NotesU
Dim notesUIDoc As Object
Set notesUIDoc = workspace.Editdocument(Tru
Call notesUIDoc.GOTOFIELD("Body
Call notesUIDoc.FieldClear("Bod
Call notesUIDoc.FieldAppendText
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.NotesS
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("enters
Range("B" & counter) = Join(.getItemValue("enterc
Range("C" & counter) = Join(.getItemValue("enterb
Range("D" & counter) = .getItemValue("subject")
Range("E" & counter) = .getItemValue("body")
Range("F" & counter) = .getItemValue("MailStation
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(PI CKLIST_CUS TOM, 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.getfirstdocumen t
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.GetFirstDo cument()
Set stationDoc=view.GetNextDoc ument(stat iondoc)
Instead of getnextentry from allentries. It should be faster but will not be sorted.
Set collection = uiws.Picklistcollection(PI
If Not(collection Is Nothing) Then '//User may have cancelled
Set noteCursorDoc = collection.getfirstdocumen
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.GetFirstDo
Set stationDoc=view.GetNextDoc
Instead of getnextentry from allentries. It should be faster but will not be sorted.
ASKER
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.
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
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Sounds good. I will have to play with the picklistcollection and see if I can get it working. Thanks for the help :).
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.NOTESU
Set noteCursorDoc = session.currentdatabase.cr
Set database = session.currentdatabase
Set collection = uiws.Picklistcollection(PI
If Not(collection Is Nothing) Then '//User may have cancelled
Set noteCursorDoc = collection.getfirstdocumen
If Not noteCursorDoc Is Nothing Then
Set maildoc= database.CreateDocument()
Call notecursordoc.CopyAllItems
maildoc.form="Memo"
Set bodyItm=maildoc.GetFirstIt
Call bodyitm.EmbedObject(1454,"
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.