The problem I am encountering is that some of the messages are not accessible by the user ID file, I would like to skip these files instead of the agent crashing out. The error message received is as follows:
Using the view approach if this happened I was able to delete the document temporarily and re-run the agent but if there is a way to skip documents it would be a great help.
Thanks for the help guys.
Ok I have amended the code to a point where I am almost comfortable with it.
Sub Initialize
Dim s As New notessession
Dim db As notesdatabase
Dim view As notesview
Dim doc As notesdocument
Dim nextdoc As notesdocument
Set db = s.currentdatabase
If view Is Nothing Then
Set view = db.CreateView("Encrypted",{Encrypt="1"})
End If
Set doc = view.getfirstdocument
On Error Goto ErrorHandler
While Not doc Is Nothing
nextDocument:
Set nextdoc = view.getnextdocument(doc)
'The below loop is mandatory to ensure that all $File entries are unecrypted
Forall i In doc.items
If i.isencrypted Then
i.isencrypted=False
End If
End Forall
'Must have at least 1 field encrypted in order to call Encrypt method
Dim temp As New NotesItem(doc,"tempjunk","temp")
temp.IsEncrypted=True
Call doc.encrypt
Call doc.save(True, False)
'This portion can now remove the fields relative to encrypting the
'single token encrypted field.
Call doc.removeitem("$Seal")
Call doc.removeitem("$SealData")
Call doc.removeitem("SecretEncryptionKeys")
Call doc.removeitem("Encrypt")
Call doc.removeItem("tempjunk")
Call doc.save(True, False)
Set doc = nextdoc
Wend
Exit Sub
ErrorHandler:
On Error Resume nextDocument
Exit Sub
End Sub
The error handling is not playing nice;
On Error Resume nextDocument is showing up as an error.
I have tried suppressing all of the error warnings which seems to attempt to strip the encryption but I think they body of the messages is being destroyed as a result.
It is no problem to create an agent in a container database and let that agent access documents in all "target" databases and modify them accordingly - No need to copy that agent to all databases.
Only restriction: If the databases are on another server, then on the server security tab of the target server you have to enter the server with the container database as trusted server.
AND: If your agent runs longer than the allowed maximum run time for agents on the server, then it will be killed prematurely.
There is no need to create views in the target databases, you can use NotesDatabase.Search() to get the corresponding documents in the databases...
You can create views by copying them from another database. Say you create a view "Encrypted" in your db with the agent.
Then add a piece of code to get a handle of this view as a NotesDocument:
Dim dbThis As NotesDatabase
Dim viewTemplate As NotesView
Dim docView As NotesDocument
Set dbThis = s.currentDatabase
Set viewTemplate = dbThis.getView("Encrypted")
Set docView = dbThis.Getdocumentbyunid(viewTemplate.Universalid)
In the agent loop, test if view Encrypted exists, if not copy the "view template":
Set view = db.getview("Encrypted")
If view Is Nothing Then
Call docView.Copytodatabase(db)
Set view = db.getview("Encrypted")
End If
Finally, if you insist, a similar procedure might be used to copy the agent to all databases, but for me the idea of running the agent in one db sounds better.
Edited: In the view of full disclosure - of course you can create a view (I guess that was the original question).
If view Is Nothing Then
Set view = db.Createview("Encrypted", {Encrypt="1"})
End If
Or do one-shot dbSearch suggested by Torsten, with a good re-mark of Richard - if you intend to run your code several times - say if encrypted documents might get created again or re-encrypted, rather go for the view.
My method is a bit old fashioned (pre-dates availability of createView) and works well if you need more than selection formula, so you can pre-build a complicated view for re-use.
Performance-wise: whatever method you will choose either creating view using createView or copying from other db or doing dbSearch there is going to be a certain slow-down while the view gets built or dbSearch executes. Karl-Henry's approach will avoid this search/view build, but will be relatively slow if there are not many encrypted documents.
Whichever method you choose - here is a small tip to boost performance. Make your loops like this to release memory as you go; for example, assuming Karl-Henry's approach:
Dim doc1 as NotesDocument
Set doc = col.GetFirstDocument()
Do Until doc Is Nothing
Set doc1 = col.GetNextDocument(doc)
formname = doc.GetItemValue("Form")(0)
If IsElement(exclude(formname))=False Then
Call RemoveEncryption(doc) '*** Your function to remove encryption
End If
' releasing memory when processing thousands of documents improves performance and avoids crashes
Delete doc
Set doc = doc1
Loop
Now again, as you are talking only about migration (so one shot) of 20+ databases, the speed or implementation details should not be that critical.
If you have to process all (or almost all) documents in each database, you can use db.AllDocuments. It is more efficient than using db.Search() with an #All formula.
If you want to exclude certain documents, perhaps based on the form name, I would build a list of forms to exclude, and then use IsElement to check each document being processed against that list.
Dim exclude List As Boolean
exclude("FormA")=True
exclude("FormB")=True
Set col = db.AllDocuments
Set doc = col.GetFirstDocument()
Do Until doc Is Nothing
formname = doc.GetItemValue("Form")(0)
If IsElement(exclude(formname))=False Then
Call RemoveEncryption(doc) '*** Your function to remove encryption
End If
Set doc = col.GetNextDocument(doc)
Loop
Something like that. By the way, you can create the list as any data type. I just choose Boolean as it is a small data type, and that it makes the code easier to read. The IsElement() function just check if the element exists, it does not use the value you set.
You would wrap the code above in a function and call it once per database.
Appended answer, based on additional info in original question:
That should not be hard, just add error handling to your code.
Before you start to loop throung the document:
On Error Goto errHandler
Before you get the next document in the loop:
nextDocument:
At the end of your code:
Exit Sub
errHandler:
Resume nextDocument
End Sub
Try that.
Related
I'm getting the error message "Identity cannot be determined for newly inserted rows" when I attempt to edit a field for an ADO RecordSet record after calling AddNew and Update in a .vbs file. However, I'm able to access the primary key that was returned from the database.
I'm not looking for a workaround (e.g. closing the recordset and retrieving the record by its ID), I just really would like to understand why this error is occurring. I've simplified my code in a test file to rule out any other issues. What you see below is the exact code I'm executing with no files included (I've stripped the credentials out of the connection string).
Dim connString : connString = "Provider=SQLOLEDB.1;Persist Security Info=True;Data Source=localhost;Initial Catalog=;User Id=;Password="
Dim conn, rsTaskLog, sSQL
Set conn = CreateObject("ADODB.Connection")
conn.Open connString
' Create a new task log entry.
Set rsTaskLog = CreateObject("ADODB.Recordset")
sSQL = "SELECT * FROM Test"
rsTaskLog.Open sSQL, conn, 1, 3, 1 'adOpenKeyset, adLockOptimistic, adCmdText
rsTaskLog.AddNew
rsTaskLog.Update
' Set the task log result.
rsTaskLog.Fields("test_int").Value = 1 ' Error occurs on this line.
rsTaskLog.Update
rsTaskLog.Close
Set rsTaskLog = Nothing
UPDATE:
I was able to make this code work by adding the following line after the first update:
rsTaskLog.AbsolutePosition = rsTaskLog.AbsolutePosition
Something about moving the current record is putting the RecordSet back into a state where it can be edited (MoveLast and MoveFirst also worked). Anyone have any idea what is going on behind the scenes that is causing this?
The solution I came up with was adding the following line of code right after the first Update is called on the RecordSet:
rsTaskLog.AbsolutePosition = rsTaskLog.AbsolutePosition
For some reason moving the cursor position puts the RecordSet back into a state where Update can be called again without generating the error (MoveFirst and MoveLast also worked, but by setting the AbsolutePosition to itself we're able to maintain the current position). I'm not entirely sure what is going on behind the scenes here, feel free to elaborate if you know in the comments.
I am trying to automate a process to update a wise for windows package at compile time to update the productcode, package code, productversion, and the update table versionmax values.
I can successfully update the property table and the summary information for the Package Code. However, the update table is giving me problems. There are several entries in this table.
I can enumerate the existing entries, but I cannot update the existing entries. Each time I attempt to I get an error "Exception: Object required 'project.WTables(...).WRows.Row(...)'
The syntax I am using is identical to the preceding calls to update the ProductCode, ProductVersion, and Package Code.
I am using vbscript.
I am passing in the product version and full path to the wise wsi project file. In the UpdateUpgradeTable function aUpgradeGuids populate correctly with a collection of upgrade codes as I expect. All I want to do now is to change the VersionMax value for each of these codes to the current wiseProductVersion. However, vbscript seems to have some problem with the object WRows.Row(a(i)), which is an actual GUID.
I have looked at other sample scripts in the automation section of help and it does support the use of variables, and it does not look like the variables require quotes like straight text does. I am not even sure what it means, object required. Project is definitely an object. I have confirmed that. I have even tried this by inserting straight text inside the function but it still fails. I have tried it with tblProperty.WRows.Row(...) but it fails the same way. I have tried calling it with a good Upgrade Code outside of the For loop right after Set tblProperty = ... and it still fails. This type of structure works in all previous tables. It has me puzzled. Any ideas? I think this may transcend just Wise for Windows and is perhaps generic to msi as well so I am going to post under MSI too.
I have a sub main that looks like this:
Dim wiseInstallDir: wiseInstallDir = WScript.Arguments(0)
Dim wiseProductVersion: wiseProductVersion = WScript.Arguments(1)
Sub main()
Set wise = CreateObject("WfWi.Document")
Dim nResult
nResult = wise.Open (wiseInstallDir)
UpdateProductVersion wise
... 'other functions
UpdateUpgradeTable wise
wise.Save wiseInstallDir
End Sub
'This function works properly
Sub UpdateProductVersion(project)
Set tblProperty = project.WTables("Property")
tblProperty.WRows.Row("ProductVersion").WColumns("Value").Data=wiseProductVersion
End Sub
Sub UpdateUpgradeTable(project)
Set tblProperty = project.WTables("Upgrade")
Dim tmpRow,count: count = 0
Dim aUpgradeGuids: Set aUpgradeGuids = CreateObject("Scripting.Dictionary")
Const UPGRADECODE = 0
For Each tmpRow In tblProperty.WRows
Dim tRow: tRow=tmpRow.Key
Dim values: values=Split(tRow, ",")
aUpgradeGuids.Add count,values(0)
count=count + 1
Next
a = aUpgradeGuids.Items
For i = 0 To aUpgradeGuids.Count - 1
project.WTables("Upgrade")._
WRows.Row(a(i)).WColumns("VersionMax").Data=wiseProductVersion
Next
End Sub
main
EDIT:
'updated UpdateUpgradeTable
Sub UpdateUpgradeTable(project)
Set tblProperty = project.WTables("Upgrade")
Dim tmpRow
'Get the UpgradeCode for each current record and change the VersionMax value for that record.
For Each tmpRow In tblProperty.WRows
Dim tRow: tRow=tmpRow.Key
Dim values: values=Split(tRow, ",")
tblProperty.WRows.Row(values(0)).WColumns("VersionMax").Data=wiseProductVersion
Next
End Sub
I think I know the answer. I still do not have it working 100% but I found additional documentation for the Row method stating for tables with multiple key columns, commas separate key values. I have inserted the value(0), value(1), ... but I am now getting a different error. I will update once I get this working.
The upgrade table has 5 primary key values.
<!-- language: lang-vbs -->
Set rows = tblProperty.WRows
Set row = tblProperty.WRows.Row(values(UPGRADECODE), values(VERSIONMIN), values(VERSIONMAX), values(LANGUAGE), values(ATTRIBUTES))
tblProperty.WRows.Row(values(UPGRADECODE),values(VERSIONMIN),values(VERSIONMAX),values(LANGUAGE),values(ATTRIBUTES)).WColumns("VersionMax").Data=wiseProductVersion
Note that the first Set rows=... returns a valid object with its corresponding methods.
The second line fails with the message:
Exception: Wrong number of arguments or invalid property assignment: 'tblProperty.WRows.Row'
Below are the 5 primary keys for the upgrade table.
values (UPGRADECODE)
values (VERSIONMIN)
values (VERSIONMAX)
values (LANGUAGE)
values (ATTRIBUTES)
Is there another way to update the upgrade table? Is there something I am missing?
According to documentation the WRows object is a child of WTable. And it is returning a valid object for me. It has the following method:
WRow Row(BSTR strKeyValue): returns a WRow given its key value. For tables with multiple key columns, commas separate key values.
Row() is the default method.
However, my comma separated key values construct above is failing and I am not sure where to turn now. Has anyone ever worked with this before and had it working?
I have a test project I'm using to familiarise myself with VB6. Just a listbox, a button to get info, and a button to clear info:
Code:
Option Explicit
Private Sub btnGet_Click()
lstResults.DataSource = GetMenuItems
End Sub
Private Sub btnClear_Click()
lstResults.Clear
End Sub
Public Function GetMenuItems() As ADODB.Recordset
Dim rs As ADODB.Recordset
Dim conn As New ADODB.Connection
conn.ConnectionString = "File Name=C:\connString.udl"
Dim cmd As New ADODB.Command
Set cmd.ActiveConnection = conn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "dbo.GetMenuItems"
Set rs = cmd.Execute()
GetMenuItems = rs
End Function
The following error appears when I click the Get Items button (btnGet):
Compile Error: Method or Data Member Not Found
At first I thought it might be something to do with the event/button, that some sort of binding between them wasn't present. But just putting in something like "MsgBox("Hello")" works fine. Yet it doesn't even seems to get to the line where the GetMenuItems function is called before throwing the error.
This being my first whirl with VB, I'm a little stumped.
EDIT - I've had a look at the UDL file I was using too. Tested that and its connecting ok on its own.
In Sub btnGet_Click, use
Set lstResults.DataSource = GetMenuItems
Assigning object references without using Set is hardly ever the right thing to do. For what it's worth, omitting Set references the left-hand side's default property; this was part of VB6 (OK, VB4, when classes were introduced) as a help to VB3 programmers, before there were such things as objects. Whatever kind of object lstResults.DataSource returns likely does not have a default property, leading to the "Method or data member not found" error.
You've got a private sub btnGet_Click() calling a public function GetMenuItems(), which may cause problems.
Also I'm not sure you can use a udl as the connection string. Instead, open the UDL (you may need to change the file extension to .txt temporarily), take the connection string out, and use that in place of the file name.
Also, check the stored procedure exists dbo.GetMenuItems
I am trying to obtain meta data based on a users selection. I am using the ADODB namespace to provide a connection to the database and a recordset to retrieve data from it. I have set up a connection and tested it, this works fine, but the retrieval of the data is not working.
Here is the main segment:
con.Open()
cat.ActiveConnection = con
Select Case chk.Tag
Case "Yes"
For Each modMainFunctions.tbl In cat.Tables
If tbl.Type = "TABLE" Then
frmMain.lstTables.Items.Add(tbl.Name)
End If
Next
End Select
Essentially, I am checking if a particular checkbox has been selected, if it is has "i.e. case "yes" then I am trying to retrieve the Database TABLES from the provided database. However, the compiler doesn't reach the FOR loop and I cannot understand why...
modMainfunctions is my module with the main functions of my program are stored, within it I declare all my necessary variables:
Dim dbname As String = ""
Dim dblocation As String = Application.StartupPath
Dim con As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
Dim col As ADOX.Column
Dim view As ADOX.View
Dim key As ADOX.Key
Dim index As New ADOX.Index
Can anyone see where I am going wrong? I want to obtain the meta data about a database (Please do not answer with "you need to connect to..." etc because I have already a subroutine which deals with this and it's working fine, I don't think it is a connection issue)
Problem solved, rather than storing this procedure in a module I simply stored it in the active form, I am unsure if this is the "best practise" but so long as my code is working as expected I'm happy. I realised that the error was because I didn't spell the world "yes" correctly... It was looking for the word "yes" and I typed "Yes" clearly the significance of thoroughly reading your code can be learnt here!
I have been pondering this one for a while. I am programatically (in VB6) sifting through Outlook PSTs, indexing items that are in them. I have happened on to one that is a little corrupted and this is where I am having difficulty. My program attaches the PST and starts drilling down through the folders (olFolder). These Outlook created objects are supposed to have a collection that would normally hold sub folders (appropriately named Folders).
During the execution of my code I recursively call the process folder function to process all folders in the current folder, but I have one that does not have a collection. This causes an exception because I am checking the count of folders in the collection and there is nothing to check. I understand how to check for the existence of an object, but I am having a hard time checking for the existence of a collection in and object.
Update
The expression:
If Not fl.Folders Is Nothing Then
ends up throwing the exception too. The exception that I am getting is the following:
Could not complete the operation because the service provider does not support it.
This is only when trying to access this corrupted folder which appears to have a Folders Collection Property that is FUBARed.
Final
Alright; in this case I am just going to put in some in-line error handling.
If Not Err.Number = -2147221246 Then
'Do the thing with the other thing
End If
Err.Clear
If you are talking about checking whether obj.Coll.Count = 0, then see if obj.Coll Is Nothing.
well when i work web services on vb6 i have check some cases if property exist. i used that method.
It is slow but i hope that help you.
Public Function HasProperty(ByRef obj As Object, ByVal nameProperty As String) As Boolean
On Local Error GoTo hasProperty_Error
Dim Result
Result = CallByName(obj, nameProperty, VbGet)
hasProperty = True
hasProperty_Done:
Exit Function
hasProperty_Error:
If Err.Number = 438 Then
hasProperty = False
End If
Resume hasProperty_Done
End Function