Need help with vba code. please have look below on the code.
I want all the document in the view QA\QA Schedule which are in between (1sep2013 - 30sep2013). Here its not the document created date it the date which is taken form the column of the view so that i can pull the data in Excel
'Below is code which i have build what its doing is it is searching all the document and getting me the data which is taking lot of time. If can add a filter on the date we can do it little bit faster but i am not aware of the FT search syntax. how to use it on the view column. please help with this its really urgent.
Dim nSess As Object 'NotesSession
Dim sPwd As String
Dim strCnxn As String
Dim strSQL As String
Dim db As Object
Dim iviews As Object
Dim IView As Object
Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D- 00DD011186B7}
myUsername = ****
myPassword = ****
DSN1 = ("Driver={Lotus NotesSQL Driver (*.nsf)};Server=;Database=;Uid=" & myUsername & ";Pwd=" & myPassword & ";")
Call nSess.Initialize(sPwd)
Set db = nSess.GetDatabase("", "")
Set iviews = db.GetView("QA\QA Schedule")
iviews.AutoUpdate = False
Set IView = iviews.AllEntries
Set viewparentEntry = IView.Parent
Set viewEntry = viewparentEntry.GetFirstDocument
For i = 1 To IView.Count
Colval = viewEntry.ColumnValues()
For j = 0 To 20
If Colval(0) <> "2013 9" Then
Exit For
ElseIf Colval(18) >= "" Or Colval(18) <= "" Then
Exit For
ElseIf Colval(18) >= "09/01/2013" Or Colval(18) <= "09/30/2013" Then
Sheets("Sheet2").Cells(RowCount, colcount).Value = Colval(j)
colcount = colcount + 1
Else
Exit For
End If
Next
j = 0
colcount = 1
RowCount = RowCount + 1
Set viewEntry = viewparentEntry.GetNextDocument(viewEntry)
Next
There are a few options:
You could copy this view or change this view to only show documents between a certain date range, if appropriate.
You could call the FTSearch method on the database view. Some info on syntax for full text searches is here.
Here's an example that gets you a doc collection returned from a full text search on a view:
Dim db As Object
Dim iviews As Object
Dim IView As Object
Dim doc as NotesDocument
Set nSess = CreateObject("Lotus.NotesSession") 'New:{29131539-2EED-1069-BF5D- 00DD011186B7}
myUsername = ****
myPassword = ****
DSN1 = ("Driver={Lotus NotesSQL Driver (*.nsf)};Server=;Database=;Uid=" & myUsername & ";Pwd=" & myPassword & ";")
Call nSess.Initialize(sPwd)
Set db = nSess.GetDatabase("", "")
Set iviews = db.GetView("QA\QA Schedule")
iviews.AutoUpdate = False
iviews.FTSearch("[SomeDate] >= 9/1/2013 And [SomeDate] <= 9/30/2013")
Set doc = iviews.GetFirstDocument
While Not (doc Is Nothing)
// Do something here for each document
Set doc = iviews.GetNextDocument(doc)
Wend
Related
I am trying to set Selective Replication using LotusScript but I cannot get it to save. The log shows no errors and the script completes without error. The replica gets created but not with my Selective Replication set.
%REM
Agent createRenewalDB
Created Dec 14, 2016 by
Description: Comments for Agent
%END REM
Option Public
Use "xxx Routines"
Sub Initialize
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim s As New NotesSession
Dim flag As Boolean
Dim renDb As NotesDatabase
Dim renFP As String
Dim renHubDb As NotesDatabase
Dim sQuote As String
Dim nowt As String
Dim pos As Long
Dim client As String
Dim frm As String
Dim L As Long
Dim P1 As String
Dim P2 As String
Dim item As NotesItem
Dim renYN As String
Dim agent As NotesAgent
Set agent = s.CurrentAgent
Print("createRenewalDB starting")
Set db = s.Currentdatabase
Set doc = db.GetDocumentByID(agent.ParameterDocID)
'Print("got doc")
client = doc.getItemValue("Client")(0)
nowt = ""
sQuote = """"
pos = 1
Dim tmp1 As String
'Print("set vars")
tmp1 = doc.getItemValue("SearchFormula")(0)
'Print("got search formula")
frm = StrLeft(StrRight(tmp1,"ix_client;"),")")
'### strip out quotation marks
Do Until pos = 0
L = Len(frm)
pos& = InStr(1,frm,sQuote)
If pos <> 0 Then
P1 = Left(frm,pos - 1) ' Part 1 of the text string
P2 = Right(frm,L- pos )
frm = P1 & nowt & P2
End If
Loop
'Print("stripped out the rubbish")
'#### Setup a new Renewals document if none exixts and Renewals has been selected
Set item = doc.getfirstitem("EnabledApps")
renYN = item.text
If InStr(renYN, "32") > 0 Then
'##### Get the Renewals Quotes Db
Set renHubDb = Get_Specific_Db_Object("Renewal Quotes", "xxx-01")
If renHubDb Is Nothing Then
MsgBox("Fail: Could not get the Renewals Quotes database on Hub, exiting renewals created.")
Exit Sub
End If
renFP = doc.getItemvalue("Renewals")(0)
'Msgbox("Renewals to be set up " + renFP)
Set renDb = s.GetDatabase("",renFP,False)
If renDb Is Nothing Then '#### No replica, so create one
Print("Creating a replica for " + client)
Set renDb = renHubDb.CreateReplica("xxx-01",renFP)
renDb.Title = client
Dim rep As NotesReplication
Dim re As NotesReplicationEntry
Dim server As String
server = "xxx-xxx-01"
Set rep = renDb.ReplicationInfo '## Get the replication info
Set re = rep.GetEntry("-",server,True) '## get the replication entry - true creates it
re.Formula = "SELECT #Contains(client;" &"""" & frm & """" & ")" '## add the selective replication
Print("selective replication formula " + re.Formula)
'## save both
Call re.Save
Call rep.Save()
Print(re.Formula) '## formula is still set correctly at this point
End If
If renDb Is Nothing Then
MsgBox("Could not create a replicate for " + client)
Exit Sub
End If
Else
MsgBox("No Renewals " + renYN)
End If
Print("###########################################Finished creating the replica - agent")
End Sub
Any thoughts?
Lotus Notes 9.0.1
Lotus Domino 9.0.1
Code is in an agent that has Full Admin Access Set on the Security Tab.
Thanks
Graeme
Sub Initialize
On Error GoTo ErrorOut
Dim sess As NotesSession
Dim db As NotesDatabase
Dim doc, searchDoc, reqNumDoc As NotesDocument
Dim body As NotesMIMEEntity
Dim header As NotesMIMEHeader
Dim stream As NotesStream
Dim vwSearchRequests As NotesView
Dim reqNum, totalNotify, totalAccepted, totalRejected, totalOOO, totalNoRes As Integer
Dim reqSer, reqJRSS, reqSPOC, reqNumStr As String
Dim reqDate As String
Dim reqNumColl As NotesDocumentCollection
Dim reqPanelRes As NotesItem
Dim reqPanelResValue As Variant
Set sess = New NotesSession
Set db = sess.CurrentDatabase
Set vwSearchRequests = db.GetView("RequestDocReport")
vwSearchRequests.Autoupdate = False
Set searchDoc = vwSearchRequests.GetFirstDocument
While Not searchDoc Is Nothing
reqSer = "Service"
reqJRSS = searchDoc.PS_JRSS(0)
reqSPOC = "Hiring SPOC"
totalAccepted = 0
totalRejected = 0
totalOOO = 0
totalNoRes = 0
totalNotify = 0
reqNum = searchDoc.PS_RequestNo(0)
reqNumStr = {PS_RequestNo = "} & reqNum & {"}
Set reqNumColl = vwSearchRequests.GetAllDocumentsByKey(reqNumStr)
Set reqNumDoc = reqNumColl.GetFirstDocument
While Not reqNumColl Is Nothing
If Not reqNumDoc.GetFirstItem("PanelResponse") Is Nothing Then
reqPanelResValue = reqNumDoc.GetItemValue("PanelResponse")
MsgBox CStr(reqPanelResValue(0))
'Exit Sub
If CStr(reqPanelResValue(0)) = "Accepted" Then
totalAccepted = totalAccepted + 1
End If
If CStr(reqPanelResValue(0)) = "Rejected" Then
totalRejected = totalRejected + 1
End If
If CStr(reqPanelResValue(0)) = "OOO" Then
totalOOO = totalOOO + 1
End If
Else
If CStr(reqPanelResValue(0)) = "" Then
totalNoRes = totalNoRes + 1
End If
End If
totalNotify = totalNotify + 1
Set reqNumDoc = reqNumColl.GetNextDocument(reqNumDoc)
Wend
what is the error in code? The code is getting stuck after
If Not reqNumDoc.GetFirstItem("PanelResponse") Is Nothing Then
reqPanelResValue = reqNumDoc.GetItemValue("PanelResponse")
Instead of line
While Not reqNumColl Is Nothing
write
While Not reqNumDoc Is Nothing
You got an infinitive loop because the collection reqNumColl is not nothing all the time even when you reached the last document in collection. Instead you have to test the document reqNumDoc.
Another issue might be your code for collection calculation:
reqNumStr = {PS_RequestNo = "} & reqNum & {"}
Set reqNumColl = vwSearchRequests.GetAllDocumentsByKey(reqNumStr)
The way you coded it the first sorted column in view should contain
PS_RequestNo = "12345"
Probably, your view contains in first sorted column just the request number. If so, your code would be just:
Set reqNumColl = vwSearchRequests.GetAllDocumentsByKey(reqNum)
if column contains a numeric value or
Set reqNumColl = vwSearchRequests.GetAllDocumentsByKey(cStr(reqNum))
if it contains a string.
Apart from any other problems you might have in your code (and #Knut is correct about the cause of your infinite loop), this is not a good pattern:
If Not reqNumDoc.GetFirstItem("PanelResponse") Is Nothing Then
reqPanelResValue = reqNumDoc.GetItemValue("PanelResponse")
You're retrieving the item twice when you don't actually have to.
This woould be much better:
If reqNumDoc.HasItem"PanelResponse") Then
reqPanelResValue = reqNumDoc.GetItemValue("PanelResponse")
I am new to lotus script, and I'm trying to get data from a view and save it into a string. But each time I do that I get the error that Initialize Object variable not set on line 36. In my domino designer Line 36 is right under ItemNames(6).
I tried to use the code from my friend and I get the same error, while his works without a problem.
Please help I'm desperate to make this work.
Sub Initialize
On Error GoTo ERRSUB
Dim nSession As New NotesSession
Dim nDb As NotesDatabase
Dim nDoc As NotesDocument
Dim view As NotesView
Dim nitem As NotesItem
Dim strRecord As String
Dim DataString As String
Dim nList List As String
Dim ListCount As Integer
Dim FirstLine As String
Dim counter As Integer
counter = 0
Dim ItemNames(6) As String
ItemNames(0) = "Date"
ItemNames(1) = "Name"
ItemNames(2) = "Name of buyer"
ItemNames(3) = "Naziv of project"
ItemNames(4) = "value"
ItemNames(5) = "source"
ItemNames(6) = "status"
Set nDb = nSession.Currentdatabase
Set view = nDb.Getview("X_view_1")
Set ndoc = view.Getfirstdocument()
Do Until (ndoc Is nothing)
ForAll item In ItemNames
Set nitem = ndoc.Getfirstitem(item)
DataString = nitem.Values & ";"
counter = counter + 1
End ForAll
DataString = DataString & Chr(13)
Set ndoc = view.Getnextdocument(ndoc)
Loop
GoTo DONE
DONE:
MessageBox counter
Exit Sub
ERRSUB:
Call logger("Error",nSession.currentagent.name,"Initialize","","")
GoTo done
End Sub
Line 36 is DataString = nitem.Values & ";". The error is that nitem is not set properly. Probably the item is not available in a certain document. Test for nitem isn't Nothing.
Change your ForAll loop to
ForAll item In ItemNames
Set nitem = ndoc.Getfirstitem(item)
If Not nitem Is Nothing then
DataString = DataString & nitem.Text
End If
DataString = DataString & ";"
counter = counter + 1
End ForAll
I would writ it something like this below.
Among the things I notice in your code:
* You use GoTo in your error handler, should be a Resume instead.
* You have "GoTo DONE" when the code would get there anyway, that is not needed.
* You have several variables declared that you don't use.
* You don't use much error checking, Knut's suggestion is a good one.
Here is my suggestion, this is how I would export a view:
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim col As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim DataString As String
Dim cnt List As Long
On Error GoTo errHandler
Set db = session.Currentdatabase
Set view = db.Getview("X_view_1")
Set col = view.AllEntries
'*** Set counters
cnt("total") = col.Count
cnt("processed") = 0
'*** Loop though all view entries, much faster that documents
Set entry = col.GetFirstEntry()
Do Until entry Is Nothing
'*** Update status bar every 100 documents
If cnt("processed") Mod 100 = 0 Then
Print "Processed " & cnt("processed") & " of " & cnt("total") & " documents."
End If
'*** Read view columns and add to string
ForAll cv In entry.ColumnValues
DataString = cv & ";"
End ForAll
'*** Add line break to string
DataString = DataString & Chr(13)
'*** Update counter and get next entry in view collection
cnt("processed") = cnt("processed") + 1
Set entry = col.GetNextEntry(entry)
Loop
exitSub:
MsgBox "Processed " & cnt("processed") & " of " & cnt("total") & " documents.",,"Finished"
Exit Sub
errHandler:
Call logger("Error",session.CurrentAgent.Name,"Initialize","","")
Resume exitSub
End Sub
Another way to do it would be to read the the value directly from the NotesDocument:
DataString = doc.GetItemValue(item)(0) & ";"
Of course, this will only read the first value of any multi-value fields, but you can fix that like this:
DataString = Join(doc.GetItemValue(item),"~") & ";"
This will put a ~ between each value if there are more than one, then you can process that the way you like.
I have two databases: one holds the employee summary info, and the other one holds the serial number of the employee. On the database1, I have this agent that lets you import text file which contains updated records of the employee. But, In order for this agent to import a text file records successfully, the text file to be import must have a serial number record same as on the database2. It's working by the way, but I need to create a log when importing, still got no idea on how to resolve this. The logs(date imported, success and fail file imported) must be viewed on the fields. Can you help me out? Here's my code:
LoadAPMSAWDdoc
Sub LoadAPMSAWDdoc(Rname As Variant, directory As Variant, Datef As Variant)
Dim session As New NotesSession
Dim Tdoc As NotesDocumentCollection
Dim dateTime As New NotesDateTime ("01/01/2000")
'12/20/2005
Dim LocView As notesview
Dim LocDoc As NotesDocument
Dim subsidiary As String
Print "Loading APMSAWD - Award Information"
Set cdb = Session.CurrentDatabase
'12/20/2005
'StaffServerName = cdb.Server
Set LocView = cdb.GetView("LsvLocationProfile")
'02/07/2006
'Set LocDoc = LocView.getdocumentbykey(cdb.Server)
Set LocDoc = LocView.getfirstdocument
StaffServerName = LocDoc.z_ExtServer(0)
'SearchFormula$ = "Select Form = ""dfAward"" & #Date(s_Created) != #Date(#Today) "
If (ibmmy = True) And (ibmgdc = True) Then
SearchFormula$ = "Select Form = ""dfAward"" "
ElseIf (ibmmy = True) Then
SearchFormula$ = "Select Form = ""dfAward"" & I_GDCEmployee = ""IBM MY"""
Else
SearchFormula$ = "Select Form = ""dfAward"" & I_GDCEmployee = ""IBM GDC"""
End If
Set Tdoc = cdb.Search( SearchFormula$, DateTime, 0 )
If Tdoc.Count <> 0 Then
Call Tdoc.RemoveAll(True)
End If
'Get an unused file number
file_no% = Freefile()
Open (Trim(directory + "apmsawd.txt")) For Input As file_no%
Set db = Session.CurrentDatabase
Select Case Datef
Case "DMY" : Cdatf = "dd/mm/yyyy"
Case "MDY" : Cdatf = "mm/dd/yyyy"
Case "YMD" : Cdatf = "yyyy/mm/dd"
Case Else :
Print "LoadAPMSAWDdoc - Unknown system date format"
Exit Sub
End Select
Do While Not Eof(file_no%)
Line Input #file_no%, tmp
SerialNo = Trim$(Mid$(tmp,1,6))
AB = 0
For i = 29 To 0 Step -1
x1 = 8 + (i * 50)
x2 = 11 + (i * 50)
x3 = 41 + (i * 50)
x4 = 49 + (i * 50)
temp = Strconv(Trim$(Mid$(tmp,x2,30)),3)
If temp <> "" Then
Redim Preserve ACode(AB)
Redim Preserve ADes(AB)
Redim Preserve ADate(AB)
Redim Preserve AAmt(AB)
Acode(AB) = Trim$(Mid$(tmp,x1,3))
ADes(AB) = temp
If Trim$(Mid$(tmp,x3,8)) <> "" Then
AD1 = Setdate(Trim$(Mid$(tmp,x3,8)), "mm/dd/yy", Datef)
ADate(AB) = Cdat(Format(AD1, Cdatf))
'Datenumber ( Val(Trim$(Mid$(tmp,x3+6,2))) , Val(Trim$(Mid$(tmp,x3+3,2))) , Val(Trim$(Mid$(tmp,x3,2))) )
Else
ADate(AB) = Null
End If
AAmt(AB) = Val(Trim$(Mid$(tmp,x4,9)))
AB = AB + 1
Else
Exit For
End If
Next
subsidiary = Filter(CStr(SerialNo))
If (subsidiary = "AMY" And ammmy = True) Or (subsidiary = "ADC" And aaadc = True) Then
Set doc = New NotesDocument(db)
doc.Form = "dfAward"
doc.E_StaffSerialNo = SerialNo
doc.I_GDCEmployee = subsidiary
If AB = 0 And Trim$(Mid$(tmp,1461,30)) = "" Then
Redim Preserve ACode(AB)
Redim Preserve ADes(AB)
Redim Preserve ADate(AB)
Redim Preserve AAmt(AB)
ACode(0) = ""
ADes(0) = ""
ADate(0) = Null
AAmt(0) = Null
End If
doc.E_AwardType = ADes
doc.E_AwardDate = ADate
doc.E_AwardAmt = AAmt
doc.G_AuthorDisp = Rname
doc.s_created = Now
Call doc.Save (True, True)
End If
Loop
Close file_no%
Print "Award information imported"
End Sub
I'm sorry if I only posted some functions coz my code is too long and can't fit here.
First of all: It is VERY bad practice, to permanently delete all documents that match a search criteria just to directly afterwards add them back.
Deletion stubs will explode and this database will become slower and slower and at some point will not be usable anymore.
Better build a key to identify the document, get the document using the key and then update if necessary...
I usually build a list with all keys / unids (or documents, if there are not to much of them) and remove any document found in the "source" (text document in your case) from that list after processing.
Any document left in the list after running through the import file can be deleted...
Dim lstrUnids List as String
Set doc = Tdoc.GetFirstDocument()
While not doc is Nothing
lstrUnids( doc.E_StaffSerialNo(0) ) = doc.UniversalID
set doc = TDoc.GetNextDocument(doc)
Wend
But now back to your Question:
To write a simple Log you can use the NotesLog- Class. You can either log to a database (Template: Agent Log ), log to a mail or log to the Agents log (complicated to read) or even to a file.
Just do it like this:
Dim agLog as New NotesLog( "MyImportLog" )
Call agLog.OpenNotesLog( Server , logdbPath )
...
Call agLog.LogMessage( "Award information imported" )
...
Call agLog.Close() 'IMPORTANT !!!!
I use the below script in querysave event of a form. The logic is when I save the form the sequence should get displayed in the view in two columns. like "115-" in one column and the sequence "00001", "00002", ... in the second column. The first two documents gets saved without any issue. When I save try to save 3rd and more documents, its displaying "00002" only every time after that. I am not able to identify what is the mistake. Can somebody help please.
Sub Querysave(Source As Notesuidocument, Continue As Variant)
Dim SESS As New NotesSession
Dim w As New NotesUIWorkspace
Dim uidoc As NotesUIdocument
Dim Doc As NotesDocument
Dim RefView As NotesView
Dim DB As NotesDatabase
Dim RefDoc As NotesDocument
Set DB = SESS.CurrentDatabase
Set uidoc = w.CurrentDocument
Set Doc = uidoc.Document
Set RefView = DB.GetView("System\AutoNo")
Dim approvedcnt As Integer
approvedcnt = Cint(source.fieldgettext("appcnt"))
If uidoc.EditMode = True Then
Financial_Year = Clng(Right$(Cstr(Year(Now)),3)) + 104
If Month(Now) >= 4 Then Financial_Year = Financial_Year + 1
DocKey = Cstr(Financial_Year)& "-"
New_No = 0
Set RefDoc = RefView.GetDocumentByKey(DocKey , True)
If Not(RefDoc Is Nothing) Then New_No = Clng(Right$(RefDoc.SETTLEMENT_NO(0),5))
New_No = New_No + 1
autono = DocKey & "-" & Right$("00000" & Cstr(New_No) ,5)
Application ="ST"
Latest_No = Application + autono
Doc.SETTLEMENT_NO = Latest_No
Doc.FinFlag="Finish"
Call SESS.SetEnvironmentVar("ENV_ST_NO",Right$("00000" & Cstr(DefNo&) ,5))
'Call uidoc.FieldSetText("SETTLEMENT_NO",Latest_No)
Call uidoc.Refresh
Else
Exit Sub
End If
get_ex_rate
get_cv_local
Call uidoc.FieldSetText("Flag1", "A")
If approvedcnt = 12 And uidoc.FieldGetText("STATUS") = "APPROVE" Then
Call uidoc.fieldsettext("Flag2", "B")
End If
Dim answer2 As Integer
answer2% = Msgbox("Do you want to save this document?", 1, "Save")
If answer2 = 1 Then
Print "Saving"
End If
If answer2 = 2 Then
continue=False
Exit Sub
End If
uidoc.Refresh
uidoc.close
End Sub
I imagine your call to GetDocumentByKey is getting the wrong document or not the next one in sequence. Make sure the view is sorted properly and perhaps call the refresh method on the view before calling GetDocumentByKey.