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!
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 link an Oracle table to access using the following Visual Basic 6.0 code:
Dim objApp, objDB, objTable As Object
Dim strFile, strConnect, strLocalTable, strServerTable As String
strFile = "C:\path\to\base.mdb"
strLocalTable = "local"
strServerTable = "BASE.TABLE_NAME"
strConnect = "ODBC;Driver={Microsoft ODBC for Oracle};ConnectString=name.world;Uid=username;Pwd=password;"
Set objApp = CreateObject("Access.Application")
objApp.OpenCurrentDatabase strFile
Set objDB = objApp.CurrentDb()
Set objTable = objDB.CreateTableDef(strLocalTable)
objTable.Connect = strConnect
objTable.SourceTableName = strServerTable
objDB.TableDefs.Append objTable 'Generates 3000 Error
objDB.TableDefs.Refresh
On the second to last row I get (loosely translated from swedish by me) "Run time error 3000: Reserved error (-7778). There is no message for this error."
Any ideas on why this may be? I am told this code has worked before, so it could possibly be some kind of version conflict with updated software. The database is in Access 2000 format, and Access 2013 is installed on the computer (however, saving the database as Access 2013 does not help). Or is there something wrong with the connection string perhaps?
EDIT: I tried using a DSN in the connection string:
strConnect = "ODBC;Driver={Microsoft ODBC for Oracle};DSN='test';"
I get the same error, even though I can use that very DSN to link the tables manually in Access.
Also (as I stated in the comments) changing some of the information in the connection string (like deliberately providing an incorrect username) leads to a different error (3146: Connection failed). This leads me to believe that the connection to the database works, since it seems to be able to differentiate between good and bad credentials.
Try this connection string and leave out the 'world.' part
ODBC;DRIVER={Oracle in orahome32};UID=userId;PWD=password;SERVER=servername;dbq=servername
(I was having trouble earlier today with connections that left the dbq out)
Or maybe your existing one will work, but regardless...I think Access likes you to create the table default in one swoop and not break things up so.....
Instead of this:
Set objTable = objDB.CreateTableDef(strLocalTable)
objTable.Connect = strConnect
objTable.SourceTableName = strServerTable
Try This:
Set objTable = objDB.CreateTableDef(strLocalTable, dbAttachSavePWD, strServerTable, strConnect)
(NOTE: the dbAttachSavePWD will help avoid users getting prompted for password every time they touch the table; leave it out if that is not desired)
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.
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