Showing posts with label Lotusscript. Show all posts
Showing posts with label Lotusscript. Show all posts

Friday, October 1, 2010

Unique Variant in Lotusscript

Get unique values in a variant by calling the below function in lotusscript.

Pass the variant to Unique function.


Function Unique(vSourceArray As Variant)
Dim iFound As Integer
Dim sTargetArray() As Variant

Redim sTargetArray(0) As Variant
sTargetArray(0) = ""

Forall sText In vSourceArray
iFound = False
Forall sNewText In sTargetArray
If sText = sNewText Then
iFound = True
Exit Forall
End If
End Forall
If Not iFound Then
If sTargetArray(0) ="" Then ' First time
sTargetArray(0) = sText
Else
Redim Preserve sTargetArray(Ubound(sTargetArray)+1)
sTargetArray(Ubound(sTargetArray)) = sText
End If
End If
End Forall

Unique = sTargetArray
End Function

Wednesday, March 24, 2010

Excel active rows check in vb, lotusscript

Excel import active rows check in lotus script

Its not the best way to check the blank value in a mandatory row and stop the process while importing data from excel file.

You can get the active rows in an excel file by using SpecialCell function.

The syntax for the SpecialCells Method is;
expression.SpecialCells(Type, Value)

Where "expression" must be a Range Object. For example Range("A1:C100"), ActiveSheet.UsedRange etc.

Type=XlCellType and can be one of these XlCellType constants.
xlCellTypeAllFormatConditions. Cells of any format
xlCellTypeAllValidation. Cells having validation criteria
xlCellTypeBlanks. Empty cells
xlCellTypeComments. Cells containing notes
xlCellTypeConstants. Cells containing constants
xlCellTypeFormulas. Cells containing formulas
xlCellTypeLastCell. The last cell in the used range. Note this XlCellType will include empty cells that have had any of cells default format changed.
xlCellTypeSameFormatConditions. Cells having the same format
xlCellTypeSameValidation. Cells having the same validation criteria
xlCellTypeVisible. All visible cells

These arguments cannot be added together to return more than one XlCellType.

Value=XlSpecialCellsValue and can be one of these XlSpecialCellsValue constants.
xlErrors
xlLogical
xlNumbers
xlTextValues

These arguments can be added together to return more than one XlSpecialCellsValue.

The lotus script code to get the active rows count.

Set varExcel = CreateObject( "Excel.Application" )

varExcel.Visible = False ' Making the selected Excel invisible

varExcel.Workbooks.Open xlFilePath '// Open the Excel file

Set xlWorkbook = varExcel.ActiveWorkbook

Set xlSheet = xlWorkbook.ActiveSheet

xlSheet.Cells.SpecialCells(11).Activate

xlsRows = varExcel.ActiveWindow.ActiveCell.Row

xlsRows variable gives the count of the active rows in an excel file.

Tuesday, October 20, 2009

Connect ODBC/Oracle Using LC coneector classes

Lotusscript code to connect ODBC/Oracle Using LC coneector classes



Sub Initialize
On Error Goto ErrorHandler

Dim session As New NotesSession
Dim LC_S As New LCSession
LC_S.clearstatus
Set LC_Conn = New LCConnection ("odbc2")

' Make a connection...
LC_Conn.Server = "lotussystem" ‘System DSN on server…
LC_Conn.UserID = "crystal" ‘SQL Server user id…
LC_Conn.Password = "crystal" ‘SQL Server password…
LC_Conn.Metadata = "employee" ‘SQL Server table name…
LC_Conn.Connect

Dim count As Integer
Dim lsQuery As String
Dim fldLst As New LCFieldList

' Execute the Query...
lsQuery = "Select * from employee"
count = LC_Conn. Execute (lsQuery, fldLst)

Dim fldLC As LCField

Dim fldFName As LCField
Set fldFName = fldLst.Lookup ("fname")
Dim fldLName As LCField
Set fldLName = fldLst.Lookup ("lname")

' Get the AppInfo view...
Dim loDb As NotesDatabase
Dim loVw As NotesView
Dim loAppInfoDoc As NotesDocument
Set loDb = session.CurrentDatabase
Set loVw = loDb.GetView("vwAppInfo")
Set loAppInfoDoc = loVw.GetFirstDocument

Call LC_Conn.Fetch (fldLst, 1, 1)
'Msgbox fldFName.Text(0)

loAppInfoDoc.count = "1"
loAppInfoDoc.EmpName = fldFName.Text(0) + " " + fldLName.Text(0)

Set fldLC = fldLst.Lookup ("emp_Id")
loAppInfoDoc.EmpID = fldLC.Text(0)

Set fldLC = fldLst.Lookup ("job_Id")
loAppInfoDoc.Job = Cstr(fldLC.Text(0))

Set fldLC = fldLst.Lookup ("hire_date")
loAppInfoDoc.Hire_Date = Cstr(fldLC.Text(0))

Call loAppInfoDoc.save(False, False)

' Disconnect the connection...
LC_Conn.Disconnect

CleanUp:
Exit Sub

ErrorHandler:
'Msgbox result.GetExtendedErrorMessage,, result.GetErrorMessage
Msgbox "An error has occurred in button at line no. " & Erl() & " and the error is " & Str$(Err) & " " & Error$
Resume CleanUp

End Sub

Sunday, September 20, 2009

Creating Notes Documents from Excel Sheet in lotusscript


Sub Initialize
Dim lspath,lsextn As String
Dim gosession As New NotesSession
Set godb=gosession.CurrentDatabase
Set godoc=New notesDocument(godb)

'Enter the Path and the XL file that has to be Imported into th
database..like the one is shown below

lspath=Inputbox$("Enter the Excel file path for importing into
the Notes Database")

lsxlFilename=lspath

'Create an Excel sheet object

Set gvExcel=CreateObject("Excel.Application")
gvExcel.visible=False

Messagebox ("Opening Excel sheet File eneterd in Input box
previously ...")
gvExcel.Workbooks.Open lsxlFilename
Set gvxlWorkbook=gvExcel.ActiveWorkbook
Set gvxlsheet=gvxlWorkbook.Activesheet

'Start to move through the Excel file and start pulling data
from there
lsrow=0
lswritten=0

'Start Importing into the Notes Database
Print "Start impoting from Excel sheet"

Do While True

With gvxlsheet
lsrow=lsrow+1

'Create a new Notes document

Set godoc=godb.CreateDocument
godoc.Form="TestForm"
godoc.Name=.Cells(lsrow,1).Value
godoc.Division=.Cells(lsrow,2).Value
godoc.Manager=.Cells(lsrow,3).Value

'Save the Notes document
Call godoc.Save(True,True)

lswritten=lswritten+1
If godoc.Name(0)="" Then
End
End If
End With

Loop
Set godoc=Nothing
gvExcel.quit

Goto CleanUp

CleanUp:
Exit Sub

ErrorHandler:
Msgbox "An error has occurred in the agImport at line no. " &
Erl() & " and the error is " & Str$(Err) & " " & Error$
Resume CleanUp

End Sub

Creating Word Document from Notes

Here is the code to export to word:

Function exportDataToWord(lsCITRDescTitle As String, lsFileName As String, loUDoc As NotesDocument) As Integer
'%REM
On Error Goto ErrorHandlerFunc

Dim wordObj, wdocs, wRange As Variant
Set wordObj = CreateObject("Word.Application")
Set wdocs = wordObj.Documents.Add(lsFileName)
wdocs.Activate
'wdocs.

Set wRange = wdocs.Bookmarks("wCITR_CreationDt").Range
Dim dateTime As New NotesDateTime(Cstr(loUDoc.CITR_CreationDt(0)))
lsEffDt$ = dateTime.DateOnly
wRange.InsertBefore lsEffDt$

Set wRange = wdocs.Bookmarks("wCITR_SNDANo").Range
wRange.InsertBefore Cstr(loUDoc.CITR_SNDANo(0))

Set wRange = wdocs.Bookmarks("wCITR_Number").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Number(0))

lvConxDiscInfo = Evaluate(|@Implode(CITR_ConxDisc; @Char(13))|, loUDoc)
lsConxDiscInfo$ = Trim$(Cstr(lvConxDiscInfo(0)))
Set wRange = wdocs.Bookmarks("wCITR_ConxDisc").Range
wRange.InsertBefore lsConxDiscInfo$

lvOtherDiscInfo = Evaluate(|@Implode(CITR_OtherDisc; @Char(13))|, loUDoc)
lsOtherDiscInfo$ = Trim$(Cstr(lvOtherDiscInfo(0)))
Set wRange = wdocs.Bookmarks("wCITR_OtherDisc").Range
wRange.InsertBefore lsOtherDiscInfo$

Dim z As Integer
Dim lvCITRPurposes As Variant
Dim lsSetOtherReason As String
If (lsCITRDescTitle = "First Version") Then
Set wRange = wdocs.Bookmarks("wCITR_PurposeOfDisc").Range
wRange.InsertBefore Cstr(loUDoc.CITR_PurposeOfDisc(0))

lvContainOther = Evaluate(|@Contains(CITR_PurposeOfDisc; "Other")|, loUDoc)
lsContainOther$ = Trim(Cstr(lvContainOther(0)))
If (lsContainOther$ = "True" Or lsContainOther$ = "true" Or lsContainOther$ = "1") Then
lvCITR_OtherReasons = Evaluate(|@Implode(CITR_OtherReasons; @Char(13))|, loUDoc)
lsCITR_OtherReasons$ = Trim$(Cstr(lvCITR_OtherReasons(0)))
Set wRange = wdocs.Bookmarks("wCITR_OtherReasons").Range
wRange.InsertBefore lsCITR_OtherReasons$
End If
Else
lsCap1$ = Trim(Cstr(wDocs.chkA.Caption))
lsCap2$ = Trim(Cstr(wDocs.chkB.Caption))
lsCap3$ = Trim(Cstr(wDocs.chkC.Caption))
lsCap4$ = Trim(Cstr(wDocs.chkD.Caption))
lsCap5$ = Trim(Cstr(wDocs.chkE.Caption))
lvCITRPurposes = loUdoc.GetItemValue("CITR_PurposeOfDisc")
For z = 0 To Ubound(lvCITRPurposes)

If (Trim(Cstr(lvCITRPurposes(z))) = lsCap1$) Then
wDocs.chkA.value = True
Elseif (Trim(Cstr(lvCITRPurposes(z))) = lsCap2$) Then
wDocs.chkB.value = True
Elseif (Trim(Cstr(lvCITRPurposes(z))) = lsCap3$) Then
wDocs.chkC.value = True
Elseif (Trim(Cstr(lvCITRPurposes(z))) = lsCap4$) Then
wDocs.chkD.value = True
Elseif (Trim(Cstr(lvCITRPurposes(z))) = lsCap5$) Then
wDocs.chkE.value = True
End If

If (Trim(Cstr(lvCITRPurposes(z))) = "Other") Then
lsSetOtherReason = "1"
End If

Next

If (lsSetOtherReason = "1") Then
lvCITR_OtherReasons = Evaluate(|@Implode(CITR_OtherReasons; @Char(13))|, loUDoc)
lsCITR_OtherReasons$ = Trim$(Cstr(lvCITR_OtherReasons(0)))
wdocs.txtbxA.value = lsCITR_OtherReasons$
End If
End If
lvCITR_Address = Evaluate(|@Implode(CITR_Address; @Char(13))|, loUDoc)
lsCITR_Address$ = Trim$(Cstr(lvCITR_Address(0)))
Set wRange = wdocs.Bookmarks("wCITR_Address").Range
wRange.InsertBefore lsCITR_Address$

Set wRange = wdocs.Bookmarks("wCITR_Address1").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Address1(0))

Set wRange = wdocs.Bookmarks("wCITR_OtherCompName").Range
wRange.InsertBefore Cstr(loUDoc.CITR_OtherCompName(0))

Set wRange = wdocs.Bookmarks("wCITR_City").Range
wRange.InsertBefore Cstr(loUDoc.CITR_City(0))

Set wRange = wdocs.Bookmarks("wCITR_StateCountry").Range
wRange.InsertBefore Cstr(loUDoc.CITR_StateCountry(0))

Set wRange = wdocs.Bookmarks("wCITR_Zip").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Zip(0))

Set wRange = wdocs.Bookmarks("wCITR_Representor").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Representor(0))

Set wRange = wdocs.Bookmarks("wCITR_Signer").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Signer(0))

Set wRange = wdocs.Bookmarks("wCITR_Desig").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Desig(0))

Set wRange = wdocs.Bookmarks("wCITR_Title").Range
wRange.InsertBefore Cstr(loUDoc.CITR_Title(0))

wdocs.SaveAs lsFileName$
wdocs.Close
wordObj.Application.Quit

lsPathOfWord$ = "C:\Program Files\Microsoft Office\Office\WINWORD.EXE " & Cstr(lsFileName)
taskId% = Shell(lsPathOfWord$, 1)

exportDataToWord = True

Exit Function

ErrorHandlerFunc:
Print "Error Msg : " & Error$() & " at line no. of Function : " & Erl()
Resume Next
'%END REM
End Function

Tuesday, September 8, 2009

Check current users role is [Admin] in lotusscript

Today i came across to check the current user's role is [Admin] or not in Lotusscript.


Here is the code: LotusScript:

Sub Initialize
Dim session As New notessession
Dim db As NotesDatabase
Dim roles As Variant

roles = Evaluate("@UserRoles = ""[Admin]""")
Msgbox Cstr(roles(0)) ' if the message box shows 1 then the current user has Admin role.
End Sub

Monday, September 7, 2009

Agent to customize Dialogbox to take the inputs from the user



Create a form with the name "DlgPreview"

Customize the form "DlgPreview" as shown below


Click on Submit and write the below lotusscript code:

Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesuiDocument
Set uidoc = ws.CurrentDocument
Call ws.RefreshParentNote( )
Call uidoc.Close
End Sub

Cancel Button Code:

Formula Language: @Command([FileCloseWindow])

Write an agent to trigger the workspace dialogbox.

Agent Code : LotusScript :

Sub Initialize
Dim ws As New NotesUIWorkspace
Dim s As NotesSession
Dim db As NotesDatabase
Dim doc As NotesDatabase
Dim dlgDoc As NotesDocument
Set s = New notessession
Set db = s.CurrentDatabase
Set dlgDoc = db.CreateDocument ()
If ws.DialogBox("DlgPreview",True,True,True,False,False,False,"Preview Dialog Box",dlgDoc,True,True) Then
Msgbox DlgDoc.DlgField(0)
End If
End Sub

After you run the agent it will display the below dialogbox to enter the value


Search This Blog