' Code copyright 2008 Jimmy Mooney Interactive
' Unauthorized copying or distribution is prohibited
' Creative Commons Attribution-Noncommercial-No Derivative Works 3.0 United States License
' http://creativecommons.org/licenses/by-nc-nd/3.0/us/
Option Public
Option Explicit
Dim person As String
Sub Initialize
'Code starts here ======================
Dim session As New NotesSession
Dim requestDoc As NotesDocument
Dim queryString As String
Set requestDoc = session.DocumentContext
If Not (requestDoc Is Nothing) Then
queryString = requestDoc.Query_String_Decoded(0)
End If
Dim func As String
func = Ucase(GetQueryElement(queryString, "func"))
If(func = "ADDRESSBOOK")Then
GetAddressBook
Print |Notes Pro Was Successfully Installed
Notes Pro is now setup on your server.
Buy Notes Pro for your iPhone from the App Store
Once installed, use the following settings in Notes Pro on your iPhone:
HTTPS:
|+requestDoc.Https(0)|Server URL:
|+requestDoc.Server_Name(0)+||+requestDoc.Path_Translated(0)+|User Name:
Your Lotus Notes User NamePassword:
Your Lotus Notes PasswordVisit JM Interactive: iPhone Development for more detailed instructions.
Thanks for using Notes Pro!
Notes Pro Was Successfully Installed
Notes Pro is now setup on your server.
Buy Notes Pro for your iPhone from the App Store
Once installed, use the following settings in Notes Pro on your iPhone:
HTTPS:
|+requestDoc.Https(0)|Server URL:
|+requestDoc.Server_Name(0)+||+requestDoc.Path_Translated(0)+|User Name:
Your Lotus Notes User NamePassword:
Your Lotus Notes PasswordVisit JM Interactive: iPhone Development for more detailed instructions.
Thanks for using Notes Pro!
Notes Pro Was Successfully Installed
Notes Pro is now setup on your server.
Buy Notes Pro for your iPhone from the App Store
Once installed, use the following settings in Notes Pro on your iPhone:
HTTPS:
|+requestDoc.Https(0)|Server URL:
|+requestDoc.Server_Name(0)+||+requestDoc.Path_Translated(0)+|User Name:
Your Lotus Notes User NamePassword:
Your Lotus Notes PasswordVisit JM Interactive: iPhone Development for more detailed instructions.
Thanks for using Notes Pro!
Notes Pro Was Successfully Installed
Notes Pro is now setup on your server.
Buy Notes Pro for your iPhone from the App Store
Once installed, use the following settings in Notes Pro on your iPhone:
HTTPS:
|+requestDoc.Https(0)|Server URL:
|+requestDoc.Server_Name(0)+||+requestDoc.Path_Translated(0)+|User Name:
Your Lotus Notes User NamePassword:
Your Lotus Notes PasswordVisit JM Interactive: iPhone Development for more detailed instructions.
Thanks for using Notes Pro!
Notes Pro Was Successfully Installed
Notes Pro is now setup on your server.
Buy Notes Pro for your iPhone from the App Store
Once installed, use the following settings in Notes Pro on your iPhone:
HTTPS:
|+requestDoc.Https(0)|Server URL:
|+requestDoc.Server_Name(0)+||+requestDoc.Path_Translated(0)+|User Name:
Your Lotus Notes User NamePassword:
Your Lotus Notes PasswordVisit JM Interactive: iPhone Development for more detailed instructions.
Thanks for using Notes Pro!
Notes Pro Was Successfully Installed
Notes Pro is now setup on your server.
Buy Notes Pro for your iPhone from the App Store
Once installed, use the following settings in Notes Pro on your iPhone:
HTTPS:
|+requestDoc.Https(0)|Server URL:
|+requestDoc.Server_Name(0)+||+requestDoc.Path_Translated(0)+|User Name:
Your Lotus Notes User NamePassword:
Your Lotus Notes PasswordVisit JM Interactive: iPhone Development for more detailed instructions.
Thanks for using Notes Pro!
An error has occured in the application.
Please report the following message to the system administrator:
} & errMsg & {
Click here to return:
Return
}
If fatal Then End
End Sub
Sub GetAddressBook
'Code starts here ======================
On Error Goto ErrorThrower
Dim session As New NotesSession
Dim books As Variant
Dim view As NotesView
Dim doc As NotesDocument
Dim db As New NotesDatabase("","")
Dim done As Variant
Dim requestDoc As NotesDocument
Dim queryString As String
Set requestDoc = session.DocumentContext
If Not (requestDoc Is Nothing) Then
queryString = requestDoc.Query_String_Decoded(0)
End If
Dim person As String
books = session.AddressBooks
done = False
person = GetQueryElement(queryString, "searchTerm")
'Forall b In books
' check every public address book,
' unless we're already done
'If ( b.IsPublicAddressBook ) Then
'Call b.Open( "", "names.nsf" )
' look up person's last name
' in People view of address book
If db.Open("","names.nsf") Then
Set view = db.GetView( "People" )
If(person = "") Then
Set doc = view.GetFirstDocument
Else
Set doc = view.GetDocumentByKey( person )
End If
' if person is found, display the phone number item
'from the Person document
Print ""
'Print |"| & "FirstName" & |","| & "LastName" & |","| & "InternetEmail" & |","| & "CellPhone" & |","| & "OfficePhone" & |","| & "OfficeFax" & |","| & "OfficeStreet" & |","| & "OfficeCity" & |","| & "OfficeState" & |","| & "OfficeCountry" & |","| & "OfficeZip" & |","| & "HomePhone" & |","| & "HomeStreet" & |","| & "HomeCity" & |","| & "HomeState" & |","| & "HomeCountry" & |","| & "HomeZip" & |"|
While Not ( doc Is Nothing )
If(Len(doc.LastName(0)) > 0) Then
If(person = "" Or Instr(Lcase(doc.FirstName(0)), Lcase(person)) > 0 Or Instr(Lcase(doc.LastName(0)),Lcase(person)) > 0) Then
Print ||
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print ||
'Print |"| & doc. FirstName(0) & |","| & doc. LastName(0) & |","| & doc.InternetAddress(0) & |","| & doc.CellPhoneNumber(0) & |","| & doc.OfficePhoneNumber(0) & |","| & doc.OfficeFAXPhoneNumber(0) & |","| & doc.OfficeStreetAddress(0) & |","| & doc.OfficeCity(0) & |","| & doc.OfficeState(0) & |","| & doc.OfficeCountry(0) & |","| & doc. OfficeZip(0) & |","| & doc.PhoneNumber(0) & |","| & doc.HomeStreetAddress(0) & |","| & doc.HomeCity(0) & |","| & doc.HomeState(0) & |","| & doc.HomeCountry(0) & |","| & doc. HomeZip(0) & |"|
End If
End If
Set doc = view.GetNextDocument( doc )
'done = True
Wend
Print ""
End If
'Print "#######
"
'End If
'End Forall
Exit Sub
errorThrower:
Call PrintErrorMsg("Code - " & Str(Err) & ": " & Error$ + ". (onLine " & Str(Erl) & ").", True)
Exit Sub
End Sub
Sub GetToDo
'Code starts here ======================
On Error Goto ErrorThrower
Dim session As New NotesSession
Dim view As NotesView
Dim doc As NotesDocument
Dim db As New NotesDatabase("","")
Dim done As Variant
Dim person As String
Dim startDate As NotesDateTime, endDate As NotesDateTime
done = False
Set db = session.CurrentDatabase
Set view = db.GetView( "Tasks" )
Set doc = view.GetFirstDocument
'DocumentByKey( person )
' if person is found, display the phone number item
'from the Person document
'Print ||
Print ""
'Print |"| & "StartDate" & |","| & "DueDate" & |","| & "DueState" & |","| & "Importance" & |","| & "TaskType" & |","| & "Subject" & |","| & "Message" & |"|
While Not ( doc Is Nothing )
Set startDate = New NotesDateTime(doc.StartDateTime(0))
Set endDate = New NotesDateTime(doc.DueDateTime(0))
Print ||
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
'Print |"| & startDate.DateOnly & |","| & endDate.DateOnly & |","| & doc.DueState(0) & |","| & doc.Importance(0) & |","| & doc.TaskType(0) & |","| & doc.Subject(0) & |","| & doc.GetFirstItem("Body").Abstract(5000,False,False) & |"|
'If Not ( doc Is Nothing ) Then
'Print "Phone for " + person + " is " + doc.OfficePhoneNumber( 0 )
Print ||
Set doc = view.GetNextDocument( doc )
Wend
Print ""
Exit Sub
errorThrower:
Call PrintErrorMsg("Code - " & Str(Err) & ": " & Error$ + ". (onLine " & Str(Erl) & ").", True)
Exit Sub
End Sub
Sub GetMail
'Code starts here ======================
On Error Goto ErrorThrower
Dim session As New NotesSession
Dim books As Variant
Dim view As NotesView
Dim doc As NotesDocument
Dim db As NotesDatabase
Dim done As Variant
Dim requestDoc As NotesDocument
Dim queryString As String
Dim x As Integer
Set db = session.CurrentDatabase
Set requestDoc = session.DocumentContext
If Not (requestDoc Is Nothing) Then
queryString = requestDoc.Query_String_Decoded(0)
End If
Dim count As Integer
Dim loopStop As Integer
loopStop = 0
If GetQueryElement(queryString, "count")= "" Then
count = 10
Else
count = Cint(GetQueryElement(queryString, "count"))
End If
' If db.Open("","") Then
'db.OpenMail
If db.ISOPEN = True Then
Else
db.OpenMail
End If
Set view = db.GetView("($Inbox)")
If count > view.EntryCount Then
count = view.EntryCount
End If
Set doc = view.GetLastDocument
'Print ||
Print ""
For x = 1 To count
loopStop = 0
Dim body As String
Print ""
On Error Goto inetfromError
If doc.InetFrom(0) = "" Then
Print | |
Print | |
Else
Print | |
Print | |
End If
Print | |
Print | |
On Error Goto bodyError
Print | |
On Error Goto ErrorThrower
Print ""
Set doc = view.GetPrevDocument( doc )
Next
Print ""
Exit Sub
bodyError:
Print | |
Print | |
Resume Next
errorThrower:
Call PrintErrorMsg("Code - " & Str(Err) & ": " & Error$ + ". (onLine " & Str(Erl) & ").", True)
Exit Sub
End Sub
Sub GetCalendar
'Code starts here ======================
On Error Goto ErrorThrower
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim col As NotesViewEntryCollection
Dim outputFile As Integer
Dim startDate As NotesDateTime, endDate As NotesDateTime
Dim startDate2 As NotesDateTime, endDate2 As NotesDateTime
Dim RTdescription As NotesRichTextItem
Dim rtitem As Variant
Dim plainText As String
Dim invitelist As String
Dim AllDayEventFlag As String
Dim count As Integer
Static view As NotesView
Dim dateRange As NotesDateRange
Dim ve As NotesViewEntry
Set db = session.CurrentDatabase
Set view = db.GetView("Calendar")
Set dateRange = session.CreateDateRange()
Dim queryString As String
Dim requestDoc As NotesDocument
Set requestDoc = session.DocumentContext
Dim international As NotesInternational
Set international = session.International
Dim x As Integer
If Not (requestDoc Is Nothing) Then
queryString = requestDoc.Query_String_Decoded(0)
End If
Dim RangeStart As String, RangeEnd As String
Dim RangeStartDate As NotesDateTime, RangeEndDate As NotesDateTime, RealRangeEnd As NotesDateTime
RangeStart = GetQueryElement(queryString, "rangeStart")
RangeEnd = GetQueryElement(queryString, "rangeEnd")
'Print |"| & "Subject" & |","| & "Start Date" & |","| & '"Start Time" & |","| & "End Date" & |","| & "End Time" & |","| & '"All day event" & |","| & "Location" & |","| & "Description" & |"|
'Print ||
Print ""
Set RangeStartDate = New NotesDateTime(RangeStart & " 12:00:00 AM")
Set RangeEndDate = New NotesDateTime(RangeStart & " 11:59:59 PM")
Set RealRangeEnd = New NotesDateTime(RangeEnd & " 12:00:00 PM")
x = 0
While (RangeStartDate.DateOnly <> RealRangeEnd.DateOnly)
'Print |
X= | & x & | | & RangeStartDate.DateOnly & |
|
'Print |
| & RangeEnd & |
|
'For x = 0 To 8
Call RangeStartDate.AdjustDay(1)
Call RangeEndDate.AdjustDay(1)
dateRange.Text = RangeStartDate.DateOnly & " 12:00:00 AM - " & RangeEndDate.DateOnly & " 11:59:59 PM"
Set col = view.GetAllEntriesByKey(dateRange)
'**Set col = db.UnprocessedDocuments
'**Print col.Count
'**Exit Sub
count = col.Count
Set ve = col.GetFirstEntry
While Not (ve Is Nothing)
Set doc = ve.Document
'**Print "Left to process: " + Str(count) + " - " + doc.Subject(0)
'Forall z In doc.items
' Print z.Name
' Print | -| + z.Text
'End Forall
If (doc.form(0) <> "Reply" And doc.form(0) <> "Notice") Then
AllDayEventFlag = Not (doc.AppointmentType(0) <> "2")
Set rtitem = doc.GetFirstItem("Body")
invitelist = ""
invitelist = "Chair: "& doc.CHAIR(0) & |
| & invitelist & |
Participants: |& doc.RequiredAttendees(0) & |
Optional: |& doc.OptionalAttendees(0) & |
|
On Error Goto noBody
plainText = rtitem.Abstract(5000,False,False)
On Error Goto ErrorThrower
If doc.Repeats(0) = "1" Then
Else
If Len(doc.StartDateTime(0)) = 0 Then
Set startDate = New NotesDateTime(doc.CalendarDateTime(0))
Else
Set startDate = New NotesDateTime(doc.StartDateTime(0))
End If
If Len(doc.EndDateTime(0)) = 0 Then
Set endDate = New NotesDateTime(doc.CalendarDateTime(0))
Else
Set endDate = New NotesDateTime(doc.EndDateTime(0))
End If
Print ""
Print | |
'If international.IsTime24Hour Then
' Print | |
'Else
' Print | |
'End If
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print ""
'Print |"| + doc.Subject(0) + |","| + 'startDate.DateOnly + |","| + startDate.TimeOnly + '|","| + endDate.DateOnly + |","| + endDate.TimeOnly + '|","| +AllDayEventFlag+ |","| + doc.location(0) + '" " + doc.ROOM(0) +|","| + invitelist + plainText + |"|
End If
End If
Set ve = col.GetNextEntry(ve)
count = count - 1
Wend
Set ve = col.GetFirstEntry
While Not (ve Is Nothing)
Set doc = ve.Document
'**Print "Left to process: " + Str(count) + " - " + doc.Subject(0)
'Forall z In doc.items
' Print z.Name
' Print | -| + z.Text
'End Forall
If (doc.form(0) <> "Reply" And doc.form(0) <> "Notice") Then
AllDayEventFlag = Not (doc.AppointmentType(0) <> "2")
Set rtitem = doc.GetFirstItem("Body")
invitelist = ""
invitelist = "Chair: "& doc.CHAIR(0) & |
| & invitelist & |
Participants: |& doc.RequiredAttendees(0) & |
Optional: |& doc.OptionalAttendees(0) & |
|
On Error Goto noBody
plainText = rtitem.Abstract(5000,False,False)
On Error Goto ErrorThrower
If doc.Repeats(0) = "1" Then
Dim i As Integer
For i = 0 To Ubound(doc.RepeatInstanceDates)
Set startDate = New NotesDateTime(doc.RepeatInstanceDates(i))
Set endDate = startDate
On Error Resume Next
Set endDate = New NotesDateTime(doc.EndDateTime(i))
On Error Goto ErrorThrower
If (startDate.TimeDifference(dateRange.StartDateTime) > 0 And endDate.TimeDifference(dateRange.EndDateTime) < 0) Then
Print ""
Print | |
'If international.IsTime24Hour Then
' Print | |
'Else
' Print | |
' End If
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print | |
Print ""
'Print |"| + doc.Subject(0) + |","| + 'startDate.DateOnly + |","| + startDate.TimeOnly + '|","| + endDate.DateOnly + |","| + endDate.TimeOnly + '|","| +AllDayEventFlag+ |","| + doc.location(0) + '" " + doc.ROOM(0) +|","| + invitelist + plainText + |"|
End If
Next
End If
End If
Set ve = col.GetNextEntry(ve)
count = count - 1
Wend
'Next
x = x + 1
Wend
Print ||
Exit Sub
errorThrower:
Error Err, Error & Chr(13) + "Module: " & Cstr( Getthreadinfo(1) ) & ", Line: " & Cstr( Erl )
Exit Sub
noBody:
plainText = "No description"
Resume Next
noEndDate:
Resume Next
'Code ends here =============================
End Sub
Sub SendMail
On Error Goto ErrorThrower
'Lotus Notes Automation Object Setup
Dim Maildb As NotesDatabase 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'THe current users notes mail database name
Dim MailDoc As NotesDocument 'The mail document itself
'Dim AttachME As Object 'The attachment richtextfile object
Dim Session As New NotesSession 'The notes session
Dim queryString As String
Dim requestDoc As NotesDocument
'Dim EmbedObj As Object 'The embedded object (Attachment)
'Start a session to notes
'Set Session = CreateObject("Notes.NotesSession")
Set requestDoc = Session.DocumentContext
If Not (requestDoc Is Nothing) Then
queryString = requestDoc.Query_String_Decoded(0)
End If
Dim Subject As String
Dim Recipient As String
Dim BodyText As String
Dim SaveIt As Boolean
Subject = GetQueryElement(queryString, "subject")
Recipient = GetQueryElement(queryString, "to")
BodyText = GetQueryElement(queryString, "body")
SaveIt = Cbool(GetQueryElement(queryString, "saveit"))
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName)- Instr(1, UserName, " "))) & ".nsf"
'Open the mail database in notes
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.ISOPEN = True Then
'Already open for mail
Else
Maildb.OPENMAIL
End If
'Set up the new mail document
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = Recipient
MailDoc.Subject = Subject
MailDoc.Body = BodyText
MailDoc.SAVEMESSAGEONSEND = SaveIt
'Set up the embedded object and attachment and attach it
'If Attachment <> "" Then
' Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
' Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
' MailDoc.CREATERICHTEXTITEM ("Attachment")
'End If
'Send the document
MailDoc.SEND 0, Recipient
'Clean Up
Set Maildb = Nothing
Set MailDoc = Nothing
'Set AttachME = Nothing
Set Session = Nothing
'Set EmbedObj = Nothing
Exit Sub
errorThrower:
Call PrintErrorMsg("Code - " & Str(Err) & ": " & Error$ + ". (onLine " & Str(Erl) & ").", True)
Exit Sub
End Sub