Tag: Lotusscript

  • Nieuw in 8.5: StampAllMulti – een voorbeeld hoe te gebruiken…

    De nieuwe methode StampAllMulti voor de NotesDocumentCollection en NotesViewEntryCollection classes is een waardevolle aanvulling!
    Nu kunnen we zeer snel meerdere velden in een documentenreeks van een nieuwe waarde voorzien.

    Omdat er in de Lotus 8.5 Designer Help geen voorbeeld staat voor het gebruik post ik het even hier.
    In dit geval maken we een document collectie door alle documenten in een view te selecteren, maken een nieuw (tijdelijk) document, vullen het document met een paar velden en roepen
    de methode StampAllMulti aan om de velden uit het tijdelijke document te kopieren naar alle documenten in de collectie. Snel en effectief!

    Voorbeeld:

    Sub Initialize
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim view As NotesView
    Dim vc As NotesViewEntryCollection
    Dim doc As NotesDocument

    Set db = session.CurrentDatabase
    Set view = db.GetView(“StampMulti”)
    Set vc = view.AllEntries

    Set Doc = db.CreateDocument
    Doc.ReplaceItemValue(“Company”,”INECO”).IsSummary = True
    Doc.ReplaceItemValue(“Address”,”Hoge Riem 27″).IsSummary = True
    Doc.ReplaceItemValue(“Zipcode”,”6666JA”).IsSummary = True
    Doc.ReplaceItemValue(“City”,”Heteren”).IsSummary = True
    Doc.ReplaceItemValue(“Country”,”The Netherlands”).IsSummary = True
    Doc.ReplaceItemValue(“Phone”,”+31653353140″).IsSummary = True
    Call vc.StampAllMulti( Doc )

    End Sub

    Uit de Help:

    Replaces the values of specified items in all documents associated with the entries in a view collection.

    Note
    This method is new with Release 8.5.
    Defined in

    NotesViewEntryCollection
    Syntax

    Call notesViewEntryCollection.StampAllMulti( document )

    EN

    Parameters:

    document
    NotesDocument. The document contains multiple items, each with values appropriate for the item type.

    Usage
    If an item does not exist, it is created. If the item is of a different data type, the existing item will be deleted and a new item of the new data type created.

    The item values are immediately written to the documents on the server. You do not have to use the Save method of NotesDocument after StampAllMulti. However, any documents modified by your script must be saved before calling StampAllMulti.

    This method does not modify existing NotesDocument objects. Documents must be retrieved again to see the changes.

    If you do not have the proper access to modify one or more of the documents in the view entry collection, this method will return ERR_NOTES_STAMP_FAILED. Only those documents you are able to modify will be stamped.

  • Getthreadinfo vervangt Lsi_info

    Getthreadinfo vervangt Lsi_info

    Een van de dingen die ik mij zelf heb aangeleerd bij het maken van een applicatie is altijd gebruik te maken van een duidelijke foutafhandeling waarbij Lsi_info vaak werd gebruikt.

    Meestal zag die code er ongeveer uit als:

    Function doeDingen() As Boolean
    On Error Goto ErrorHandler
    ‘Hier komt de code ….

    Exit Function
    ErrorHandler:
    MsgBox Lsi_info(2) & ” : Error ” & Error & ” (” & Err & “) on line ” & Erl & “.”
    Exit Function
    Resume Next
    End Function

    Lsi_info

    Lsi_info was in de vroegere versies van Lotus Notes eigenlijk de enige methode om informatie te krijgen over de huidige thread.

    Een aantal regelmatig gebruikte gegevens waren:

    Lsi_info(1) ‘Huidige regel in de Lotusscript Source Code
    Lsi_info(2) ‘Huidige functie of sub
    Lsi_info(3) ‘Huidige module
    Lsi_info(6) ‘LotusScript versie
    Lsi_info(9) ‘ Taal code
    Lsi_info(11) ‘Totaal aantal code regels van de huidige module
    Lsi_info(12) ‘Naam van de aanroepende functie of sub
    Lsi_info(13) ‘Naam van de aanroepende module
    Lsi_info(14) ‘Lijst van alle modules die aangeroepen zijn tot dit moment
    Lsi_info(50) ‘ LotusScript Geheugen gealloceerd
    Lsi_info(51) ‘LotusScript Geheugen gealloceerd van het besturingssysteem
    Lsi_info(52) ‘LotusScript geheugen blokken in gebruik

    IBM beweerd echter dat Lsi_info niet gebruikt mag worden omdat dit alleen bedoeld is voor intern gebruik en mogelijk voor een instabiel systeem kan zorgen, met name op 64Bit systemen.
    Daarom heeft men in de meer recentere versies van Notes een nieuwe methode ter beschikking gesteld: GetThreadInfo.

    GetThreadInfo

    De aanbevolen schrijfwijze zou dan ook worden:

    Function doeDingen() As Boolean
    On Error GoTo ErrorLabel
    ‘En hier komt de code weer ….
    Dim i As integer
    i = Evaluate(“@Error”,Nothing)
    ExitLabel:
    Exit Function

    ErrorLabel:
    MsgBox GetThreadInfo(1) & ” : Error ” & Error & ” (” & Err & “) On Line ” & Erl & “.”, 16 , “Error”
    Resume ExitLabel
    End Function

    DOEDINGEN foutmelding met GetThreadInfo

    De aanroepen die ondersteund worden zijn:

    Getthreadinfo(0) ‘LSI_THREAD_LINE: Huidige regel in de Lotusscript Source Code
    Getthreadinfo(1) ‘LSI_THREAD_PROC: Huidige functie of sub
    Getthreadinfo(2) ‘LSI_THREAD_MODULE: Huidige module
    Getthreadinfo(3) ‘LSI_THREAD_VERSION: LotusScript versie
    Getthreadinfo(4) ‘LSI_THREAD_LANGUAGE: Taal code
    Getthreadinfo(5) ‘LSI_THREAD_COUNTRY: Regionale instelling
    Getthreadinfo(6) ‘LSI_THREAD_TICKS:Krijg actuele kloktikken
    Getthreadinfo(7) ‘LSI_THREAD_TICKS_PER_SEC: Krijg kloktikken per seconde (alleen ondersteund op platforms die parallelle verwerking van primitieven ondersteunen)
    Getthreadinfo(8) ‘LSI_THREAD_PROCESS_ID: Huidige proces-ID ophalen (alleen ondersteund op platforms die primitieven voor parallelle verwerking ondersteunen)
    Getthreadinfo(9) ‘LSI_THREAD_TASK_ID: Huidige taak-id ophalen (alleen ondersteund op platforms die primitieven voor parallelle verwerking ondersteunen)
    Getthreadinfo(10) ‘LSI_THREAD_CALLPROC: Naam van de aanroepende functie of sub
    Getthreadinfo(11) ‘LSI_THREAD_CALLMODULE: Naam van de aanroepende module

    Bronnen:

    Calling the unsupported LotusScript function LSI_Info may cause a server crash

    https://help.hcl-software.com/dom_designer/14.5.0/basic/LSAZ_GETTHREADINFO.html

     

  • LotusScript en Excel import van tekst bestand

    Om 12000 documenten te exporteren naar Excel was een LotusScript agent te lang bezig met het vullen van de cellen.
    Daarom is er gekozen om het bestand naar een comma gescheiden bestand weg te schrijven.
    De klant vond het echter lastig om dit weer te openen in Excel, vandaar dat er een stukje code moest komen om dit te automatiseren.
    Een stukje van de code:

    Sub Initialize

    Dim OfficeApplication As Variant
    Dim workbook As Variant
    Dim xlsheet As Variant
    Dim ar() As Integer
    Const xlNone = -4142
    Const xlAutomatic = -4105
    Const xlUnderlineStyleNone = -4142
    Const xlThemeFontNone = -4142
    Const xlInsertDeleteCells = 1
    Const xlDelimited = 1
    Const xlTextQualifierDoubleQuote = 1
    Const xlTextFormat = 2

    ….. declareer dingen …

    fList(“Form”) = “Form”
    …. etc…

    Set ws = New NotesUIWorkspace
    filenames = ws.SaveFileDialog(False,”File name”,, “c:\”, “export” & Format(Today,”ddmmyyyy”) & “.txt”)
    If (Isempty(filenames)) Then
    Exit Sub
    End If

    Set curDB = Session.CurrentDatabase
    Set View = curDB.GetView(“myView”)
    View.AutoUpdate = False

    fileNum% = Freefile()
    Open filenames(0) For Output As fileNum%

    Forall i In fList
    mString$ = mString$ & “,” & i
    End Forall
    Print #fileNum%, Strright(mString$,”,”)

    Set Doc = View.GetFirstDocument
    Do Until Doc Is Nothing
    mString$ = “”

    Forall i In fList
    If Doc.HasItem(Listtag(i)) Then
    Set item = Doc.GetFirstItem(Listtag(i))
    Select Case item.Type
    Case 768
    mString$ = mString$ & “,” & Replace(Doc.GetFirstItem(Listtag(i)).Text,”,”,”.”)
    Case 1024
    mString$ = mString$ & “,” & Replace(Format(item.Values(0),”dd-mm-yyyy”),”-“,”/”)
    Case Else
    mString$ = mString$ & “,” & Replace(Doc.GetFirstItem(Listtag(i)).Text,”,”,”;”)
    End Select
    Else
    mString$ = mString$ & “,”
    End If
    End Forall
    Print #fileNum%, Strright(mString$,”,”)

    Set Doc = View.GetNextDocument(Doc)

    Loop

    Close fileNum%

    con = “TEXT;” & filenames(0)
    If Not (setOfficeApplication(“Excel.application”)) Then Exit Sub ‘ start Excel met een functie

    rgbColor& = xlNone

    x = 0
    Forall i In fList
    Redim Preserve ar(x) As Integer
    ar(x) = xlTextFormat
    x = x + 1
    End Forall

    Set workbook = OfficeApplication.Workbooks.Add ()
    Set xlsheet = OfficeApplication.Workbooks(1).Worksheets(1)
    With xlsheet.QueryTables.Add(con,xlsheet.Range(“A1″) )
    .Name = Strright( filenames(0),”\”)
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 1252
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = ar
    .TextFileTrailingMinusNumbers = True
    .Refresh
    End With

    ExcelClose:

    On Error Resume Next
    OfficeApplication.Cells.EntireColumn.Autofit
    OfficeApplication.Rows(“1:1″).Select
    OfficeApplication.Selection.AutoFilter
    OfficeApplication.Visible = True

    Exit Sub
    ErrorHandler:
    Msgbox Lsi_info(2) & ” ” & Error & ” (” & Err & “) on line ” & Erl
    Resume ExcelClose

    End Sub

  • PDFCreator aansturen met LotusScript

    PDFCreator aansturen met LotusScript

    Voor een klant moest er een export gemaakt worden van alle Notes documenten in een database.
    Dit moest gebeuren door deze als PDF af te drukken.
    Als PDF printer heb ik gekozen voor de open source applicatie PDFCreator, dat makkelijk aan te sturen is en erg nette afdrukken maakt.
    Omdat er geen tijd was om te onderzoeken of dit op de achtergrond kon gebeuren heb ik gekozen om een eenvoudig script te maken dat via de Notes cliënt door een weergave loopt, elk document opent, de bestandsnaam aan PDFCreator doorgeeft via COM, afdrukt naar de default (PDF) printer, en het document sluit.

    Code

    Sub Initialize
    On Error GoTo ErrorHandler
    '....... Declare And Set items.....
    
    sPDFPath$ = "C:\"
    If Dir(sPDFPath$,16) = "" Then
    MsgBox sPDFPath$ & " kan niet worden geopend",16,"Export"
    End If
    
    Set PDFCreator = CreateObject("PDFCreator.clsPDFCreator")
    If Not PDFCreator.cStart("",True) Then
    MsgBox "PDF printer kan niet worden gestart",16,"Export"
    GoTo TheEnd
    End If
    
    Set Doc = View.GetFirstDocument
    Do Until Doc Is Nothing
    
    sPDFName$ = doc.NoteID & ".pdf"
    FileName$ = sPDFPath$ & sPDFName$
    If Not Dir(FileName$) = "" Then
    Kill FileName$
    End If
    
    With PDFCreator
    .cOption("UseAutosave") = 1
    .cOption("UseAutosaveDirectory") = 1
    .cOption("AutosaveDirectory") = sPDFPath$
    .cOption("AutosaveFilename") = sPDFName$
    .cOption("AutosaveFormat") = 0
    .cClearCache
    End With
    
    Set uiDoc = ws.EditDocument(False,Doc,True,"",True,True)
    Call uiDoc.Print(1)
    Call uiDoc.Close(True)
    Set uiDoc = Nothing
    
    If Not isFileCreated(FileName$) Then
    'Foutafhandeling
    End If
    Set Doc = View.GetNextDocument(Doc)
    Loop
    
    TheEnd:
    On Error Resume Next
    PDFCreator.cClose
    Set PDFCreator = Nothing
    Exit Sub
    
    ErrorHandler:
    MsgBox GetThreadInfo(1) & " " & Error & " (" & Err & ") op regel " & Erl & "."
    Resume TheEnd
    End Sub
    
    Function isFileCreated ( filePath As String ) As Boolean
    On Error GoTo errorHandler
    Dim counter As Integer
    Dim fSize As Long
    
    isFileCreated = False
    Do While Dir$(filePath$, 0) = ""
    If counter > 30 Then
    Exit Function
    End If
    Sleep 1
    counter = counter + 1
    Loop
    
    fSize = FileLen(filePath$)
    Counter = 0
    Do While (FileLen(filePath$) = 0 Or FileLen(filePath$) > fSize)
    fSize = FileLen(filePath$)
    If counter > 30 Then
    Exit Function
    End If
    Sleep 1
    counter = counter + 1
    Loop
    
    isFileCreated = True
    
    Exit Function
    ErrorHandler:
    MsgBox GetThreadInfo(1) & " " & Error & " (" & Err & ") op regel " & Erl & "."
    Exit Function
    Resume Next
    End Function
  • Aantal dagen in een bepaalde periode met LotusScript

    Voor een applicatie moest herhaaldelijk uitgerekend worden hoeveel dagen er in een bepaalde periode zitten.
    De volgende functie voldeed hier goed:

    Input: getDaysBetween(“31-12-2007″,”01-01-2007”, “1,7” ,”25/12/07 – 26/12/07,05-12-2007″,Doc)  

    Output: 258

    Function getDaysBetween(strStart As String, strEnd As String,daysToExclude As String , datesToExclude As String ,Doc As NotesDocument) As Long
    On Error GoTo ErrorHandler
    Dim Formula As Variant
    Dim dLow As String
    Dim dHigh As String

    If strStart = “” Or strEnd = “” Then GoTo ErrorHandler

    strStart = {@TextToTime(“} & strStart & {“)}
    strEnd= {@TextToTime(“} & strEnd & {“)}

    If daysToExclude = “” Then
    dLow = {;0}
    Else
    dLow = {;@TextToNumber(@Explode(“} & daysToExclude & {“;”,”))}
    End If

    If Not datesToExclude = “” Then
    dLow = dLow & {;@TextToTime(@Explode(@TextToTime(@Explode(“} & datesToExclude & {“;”,”))))}
    End If

    dHigh$ = {@BusinessDays(} & strStart$ & {;} & strEnd$ & dLow & {)}
    dLow$ = {-@BusinessDays(} & strEnd$ & {;} & strStart$ & dLow & {)}

    Formula = Evaluate({@If(} & strStart & {>} & strEnd & {;} & dLow$ & {;} & dHigh$ & {)} ,Doc)

    getDaysBetween = CLng(Formula(0))

    Exit Function
    ErrorHandler:
    MsgBox GetThreadInfo(1) & ” ” & Error & ” (” & Err & “) op regel ” & Erl & “.”
    getDaysBetween = 0
    Exit Function
    Resume Next
    End Function

  • AddLinkByIds

    Met AddLinkByIds kun je een Weergave of Document koppeling in een RichText veld aanmaken door gebruik te maken van het Replica ID van de doel database en het UNID van de weergave of het document.
    De wel gedocumenteerde AppendDocLink methode heeft echt een Database, Weergave of Document object nodig, deze methode gebruikt dus alleen tekst als parameters.

    AddLinkByIds

    Gedefinieerd in

    NotesRichTextItem

    Syntax

    Call notesRichTextItem.AddLinkByIds( dbReplicaID$, serverHint$, viewUNID$, documentUNID$, comment$ [, HotSpotText$ ])

    Parameters

    serverHint$

    String. Servernaam in Canonical or Common formaat.

    viewUNID$

    String. UniversalID van de weergave. Gebruik een lege string (“”) om een database link te maken of om de “default view” te gebruiken wanneer een document koppeling wordt gebruikt.

    documentUNID$

    String. UniversalID van het document dat je wilt koppelen. Gebruik een lege string (“”) om een weergave of database koppeling te maken.

    comment$

    String. De tekst die verschijnt als de gebruiker de koppeling met de muis selecteert en vast houd (titel of help tekst).

    HotSpotText$

    Optioneel. String. Wanneer opgegeven zal de HotSpotText verschijnen als een informatie blokje met tekst als koppeling, anders wordt de betreffende pictogram afgebeeld (weergave, document of database).

    Tip: het UniversalID van een document is snel te halen uit het Informatievenster van een document.

  • Kleurfuncties zoals RGB en Webkleuren

    Soms is het nodig om kleuren te vertalen naar andere formaten.
    Excel wil bijvoorbeeld graag een RGB kleur als type Long zien, in style sheets e.d. gebruik je de Webkleuren in Hex formaat e.d.
    Meestal gebruik ik het kleurenpallet van Notes om een kleur te bepalen, en gebruik de RGB waarden om verder te werken.

    Een aantal LotusScript functies die ik dan gebruik zijn de volgende:

    Van RGB waarden naar Long (gelijk aan VBA functie, bijv. voor export naar Excel) :

    Function RGB(Byval lRed As Long, Byval lGreen As Long, Byval lBlue As Long) As Long
    ‘input 255,255,255
    Dim tmpLong As Long
    tmpLong = lRed
    tmpLong = tmpLong + (lGreen*256)
    tmpLong = tmpLong + (lBlue*Clng(65536))
    RGB = tmpLong
    ‘Output 16777215
    End Function

    Van HEX naar RGB String (met kleine aanapssing voor bijv. weergavekolommen e.d.) :

    Function HEX2RGB(Byval HexColor As String) As String
    ‘Input #FFFFFF
    HexColor = Replace(HexColor, “#”, “”)
    HEX2RGB = Val(“&H” & Mid(HexColor, 1, 2))  & “,” & Val(“&H” & Mid(HexColor, 3, 2)) & “,” & Val(“&H” & Mid(HexColor, 5, 2))
    ‘Output 255,255,255
    End Function

    Van RGB waarden naar Hex (voor Web, css e.d.):

    Function RGB2HEX(Byval lRed As Long, Byval lGreen As Long, Byval lBlue As Long) As String
    ‘ input 255,255,255
    RGB2HEX = Right(Cstr(Hex(lBlue + 256*(lGreen+256*lRed))),6)
    ‘ Output FFFFFF
    End Function

    RGB kleur naar Notes kleuren (Richtext item e.d.):

    Function RGB2NOTES(Byval lRed As Long, Byval lGreen As Long, Byval lBlue As Long) As Integer
    Dim session As New NotesSession
    Dim color As NotesColorObject
    Set color = session.CreateColorObject
    RGB2NOTES = color.SetRGB(lRed,lGreen,lBlue)
    End Function

  • Weeknummer in Lotusscript

    Weeknummer in Lotusscript

    Voor een applicatie had ik een weeknummer in Lotusscript functie nodig. Format(Now,”ww”) werkt niet goed voor jaren waar een week 53 bestaat.
    Een iets aangepaste script van de MSDN site werkt echter prima.
    Invoer Is een datum, uitvoer Is een tekst met het jaar en het weeknummer waarin de invoerdatum valt.

    Function getWeekNumber(InDate As NotesDateTime) As String
    On Error GoTo ErrorHandler
    Dim DayNo As Integer
    Dim StartDays As Integer
    Dim StopDays As Integer
    Dim StartDay As Integer
    Dim StopDay As Integer
    Dim VNumber As Integer
    Dim ThurFlag As Boolean
    Dim tmpDate As NotesDateTime
    Dim tmpWeek As Integer
    Set tmpDate = New NotesDateTime(DateSerial(Year(inDate.LSLocalTime), 1, 0))
    DayNo = InDate.TimeDifference(tmpDate)/60/60/24
    StartDay = Weekday(DateSerial(Year(InDate.LSLocalTime), 1, 1)) – 1
    StopDay = Weekday(DateSerial(Year(InDate.LSLocalTime ), 12, 31)) – 1
    StartDays = 7 – (StartDay – 1) ‘Number of days for the first calendar week
    StopDays = 7 – (StopDay – 1) ‘Number of days for last calendar week
    If StartDay = 4 Or StopDay = 4 Then ThurFlag = True Else ThurFlag = False ‘Test to see if the year has 53 weeks
    VNumber = (DayNo – StartDays – 4) / 7 ‘If first week has 4 or more days, it will be calendar week 1 otherwise it will belong to last year’s last calendar week
    If StartDays >= 4 Then
    tmpWeek = Fix(VNumber) + 2
    Else
    tmpWeek = Fix(VNumber) + 1
    End If
    If tmpWeek > 52 And ThurFlag = False Then tmpWeek = 1 ‘Handle years whose last days will belong to coming year’s first calendar week
    If tmpWeek = 0 Then ‘Handle years whose first days will belong to the last year’s last calendar week
    Set tmpDate = New NotesDateTime(DateSerial(Year(InDate.LSLocalTime ) – 1, 12, 31))
    getWeekNumber = getWeekNumber(tmpDate) ‘Recursive loop
    Else
    getWeekNumber = Format(inDate.LSLocalTime,”yyyy”) & ” week ” & CStr(tmpWeek)
    End If
    Exit Function
    ErrorHandler:
    MsgBox GetThreadInfo(1) & ” ” & Error & ” (” & Err & “) op regel ” & Erl & “.”
    Exit Function
    Resume Next
    End Function