Consulting

Results 1 to 2 of 2

Thread: Create Lotus appointment from Excel

  1. #1
    VBAX Regular
    Joined
    Mar 2016
    Posts
    12
    Location

    Create Lotus appointment from Excel

    Hi,

    I am trying to write a code which takes entries of my Excel Calendar and transfers it to LotusNotes. I found this code:

    'Public Sub SendNotesAppointment(Username as string, Subject as string, attachment as string,
    'recipient as string, Body as string, AppDate as Date, Duration as integer)
    'This public sub will write an appointment to a persons diary
    'Please specify person as first name lastname
    'also change the servername to reflect the notes server name

    Public Sub SendNotesAppointment(UserName As String, Subject As String, Body As String, AppDate As Date, Duration As Integer)
    'Set up the objects required for Automation into lotus notes
    Dim Maildb As Object 'The mail database
    Dim MailDbName As String 'The persons notes mail database name
    Dim CalenDoc As Object 'The calendar entry itself
    Dim WorkSpace As Object
    Set WorkSpace = CreateObject("Notes.NOTESUIWORKSPACE")
    'Get the engineer username and then calculate the mail file name
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " ")))
    MailDbName = "mail\" & Left$(MailDbName, 8) & ".nsf"
    'Create a new calender appointment based on template and set the attributes.
    Set CalenDoc = WorkSpace.COMPOSEDOCUMENT("SERVERNAME", MailDbName, "Appointment")
    CalenDoc.FIELDSETTEXT "AppointmentType", "2"
    CalenDoc.FIELDSETTEXT "StartDate", CStr(Format(Date, "dd/mm/yy"))
    CalenDoc.FIELDSETTEXT "Duration", CStr(Duration)
    CalenDoc.FIELDSETTEXT "Subject", Subject
    CalenDoc.FIELDSETTEXT "Body", Body
    CalenDoc.Save False, False, False
    CalenDoc.Close
    Set Maildb = Nothing
    Set CalenDoc = Nothing
    Set WorkSpace = Nothing
    End Sub
    The problem is that it doesn't seem to be a full finished code. Has anybody a completed code, which sends Excel entries to Lotus to create appointments or other calendar entries?

  2. #2
    VBAX Regular
    Joined
    Mar 2016
    Posts
    12
    Location
    I found out that this code was already updated. So i posted the code below into an empty module in Excel VBA editor. I tried to start it to figure out how it works, but nothing happens. Can anybody give me a small guideline how to change to code to make it work?

    'Public Sub SendNotesAppointment(Username as string, Subject as string,
    'Body as string, AppDate as Date, StartTime as Date, MinsDuration as
    integer)
    'This public sub will write an appointment to a persons diary
    'You must have write privleges to the calendar of the user you are going to add an appointment for
    'Username is the name of the user's mail database, used to get database
    'Also change the servername to reflect the notes server name

    Public Sub SendNotesAppointment(UserName As String, Subject As String, Body As String, AppDate As Date, StartTime As Date, MinsDuration As Integer)
    'Set up the objects required for Automation into lotus notes
    Dim MailDbName As String 'The persons notes mail database name
    Dim strSTime As String
    Dim strETime As String
    Dim CalenDoc As Object 'The calendar entry itself
    Dim WorkSpace As Object
    Dim ErrCnt As Integer
    Set WorkSpace = CreateObject("Notes.NOTESUIWORKSPACE")

    'Change this to fit your particular db naming convention based on UserName if necessary
    MailDbName = "mail\" + UserName + ".nsf"

    strSTime = CStr(FormatDateTime(StartTime, vbShortTime))
    strETime = CStr(FormatDateTime(DateAdd("n", MinsDuration, StartTime), vbShortTime))

    'MAKE SURE TO SET SERVER NAME BELOW
    Set CalenDoc = WorkSpace.COMPOSEDOCUMENT("***SERVERNAME***", MailDbName, "Appointment")

    CalenDoc.FIELDSETTEXT "AppointmentType", "0"
    CalenDoc.Refresh

    'Each loop is used to write the value to the field until the field is changed to that value

    Do Until (CDate(Right(CalenDoc.fieldgettext("StartDate"), 10)) = CDate(AppDate)) Or ErrCnt = 1000
    CalenDoc.FIELDSETTEXT "StartDate", CStr(FormatDateTime(AppDate, vbShortDate))
    CalenDoc.Refresh
    'ErrCnt is used to prevent an endless loop
    ErrCnt = ErrCnt + 1
    Loop
    ErrCnt = 0
    Do Until (CDate(CalenDoc.fieldgettext("StartTime")) = CDate(strSTime)) Or ErrCnt = 1000
    CalenDoc.FIELDSETTEXT "StartTime", strSTime
    CalenDoc.Refresh
    ErrCnt = ErrCnt + 1
    Loop
    ErrCnt = 0
    Do Until (CDate(Right(CalenDoc.fieldgettext("EndDate"), 10)) = CDate(AppDate)) Or ErrCnt = 1000
    CalenDoc.FIELDSETTEXT "EndDate", CStr(FormatDateTime(AppDate, vbShortDate))
    CalenDoc.Refresh
    ErrCnt = ErrCnt + 1
    Loop
    ErrCnt = 0
    Do Until (CDate(CalenDoc.fieldgettext("EndTime")) = CDate(strETime)) Or ErrCnt = 1000
    CalenDoc.FIELDSETTEXT "EndTime", strETime
    CalenDoc.Refresh
    ErrCnt = ErrCnt + 1
    Loop
    CalenDoc.FIELDSETTEXT "Subject", Subject
    CalenDoc.FIELDSETTEXT "Body", Body
    CalenDoc.Refresh
    CalenDoc.Save
    CalenDoc.Close
    Set CalenDoc = Nothing
    Set WorkSpace = Nothing
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •