I am opening an access db using vb.net from arcview. I open the db, perform a couple of make table queries and then add a new empty integer field into one of those tables and all performs properly. The problem comes when I try to update the new field based on other fields in that table. Below is a snippet. I always get an "Out of memory" error as soon as I get to the Update() line. It has been a while since I have done any coding. What have I forgotten? I shouldn't say all performs properly because I have been completely unable to close the db except manually. But that is another matter!
:banghead:
Code:
If Not FieldExists Then
tdf.Fields.Append(tdf.CreateField("Counter", vbInteger))
End If
strSQL = "SELECT * FROM tbltmpNewMinLands;"
rs = objAccess.CurrentDb.OpenRecordset("SELECT * FROM tbltmpNewMinLands")
PPIDOldVal = ""
Do While Not rs.EOF
PPIDVal = rs.Fields("lands").Value
If PPIDVal <> PPIDOldVal Then
Counter = 1
PPIDOldVal = PPIDVal
Else
Counter = Counter + 1
PPIDOldVal = PPIDVal
End If
With rs
.Edit()
rs.Fields("Counter").Value = Counter
.Update()
.MoveNext()
End With
Loop
rs.Close()
Thanks for the response. VB.Net
I've removed the actual query strings in strSQL as they are long but work well.
I'm using access to run the query because my queries contain user defined functions and as far as I know, that is the only way to use them in the query.
And yes, my error trap is very crude but this isn't intended for commercial use.
Under the button:
Code:
Private Sub button1_click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim lsdTablepath As String
Dim lsdTablef As String
Dim disptbls As String
Dim tmpPath As String
lsdTablepath = "K:\Shapemaker"
lsdTablef = "SG_LEGALSUBDIVISION"
tmpPath = "C:\TempM"
disptbls = "K:\Shapemaker\2007MinGIS.accdb"
'clear out the old files
'if none exist this will throw an error - ignore it!
On Error Resume Next
Kill(tmpPath + "\*.*")
Call MakeSearchBook(tmpPath, "test.dbf", disptbls)
MessageBox.Show("Done")
End Sub
Code:
Public Sub MakeSearchBook(ByVal pFolder As String, ByVal fName As String, ByVal dbtoOpen As String)
Dim accObj As Microsoft.Office.Interop.Access.Application
Dim strSQL As String
Dim target_path As String
Dim target_dbf As String
Dim tbl As dao.TableDef
Dim tbldefs As dao.TableDefs
Dim objectExists As Boolean
On Error GoTo ErrorHandler ' Run away if something goes wrong...
'
accObj = CreateObject("Access.Application")
accObj.Visible = True
accObj.OpenCurrentDatabase(dbtoOpen)
If UCase(Dir(pFolder + "\" + fName)) = UCase(fName) Then
Kill(pFolder + "\" + fName) ' Cannot overwrite existing table.
End If
strSQL = A valid SQL string
accObj.CurrentDb.Execute(strSQL)
objectExists = False
For Each tbl In accObj.CurrentDb.TableDefs ' You can't overwrite an existing table unless ...
If tbl.Name = "tbltmpNewMinLands" Then
objectExists = True
End If
Next tbl
If objectExists Then
accObj.CurrentDb.TableDefs.Delete("tbltmpNewMinLands") ' ... you get rid of it first.
objectExists = False
End If
' Now make a new tbltmpNewMinLands
strSQL = A different valid SQL make table query
accObj.CurrentDb.Execute(strSQL)
Dim tdf As dao.TableDef
Dim fld As dao.Field
Dim rs As dao.Recordset
Dim qdf As dao.QueryDef
Dim PPIDVal As String
Dim PPIDOldVal As String
Dim Counter As Long
Dim FieldExists As Boolean
tdf = accObj.CurrentDb.TableDefs("tbltmpNewMinLands")
For Each fld In tdf.Fields
If fld.Name = "Counter" Then
FieldExists = True
Exit For
End If
Next
If Not FieldExists Then
tdf.Fields.Append(tdf.CreateField("Counter", dao.DataTypeEnum.dbInteger, 12))
End If
strSQL = "SELECT * FROM tbltmpNewMinLands;"
rs = accObj.CurrentDb.OpenRecordset(strSQL)
PPIDOldVal = ""
Do While Not rs.EOF
PPIDVal = rs.Fields("lands").Value
If PPIDVal <> PPIDOldVal Then
Counter = 1
PPIDOldVal = PPIDVal
Else
Counter = Counter + 1
PPIDOldVal = PPIDVal
End If
With rs
.Edit()
.Fields("Counter").Value = Counter
.Update()
.MoveNext()
End With
Loop
rs.Close()
fld = Nothing
tdf = Nothing
'accObj.CloseCurrentDatabase()
accObj.Quit()
accObj = Nothing
Exit Sub
ErrorHandler: ' ... but give a clue as to what went wrong.
MsgBox("Error number " & Err.Number & ": " & Err.Description)
'accObj.CloseCurrentDatabase()
accObj.Quit()
accObj = Nothing
End Sub
Thanks for the response. VB.Net
I've removed the actual query strings in strSQL as they are long but work well.
I'm using access to run the query because my queries contain user defined functions and as far as I know, that is the only way to use them in the query.
And yes, my error trap is very crude but this isn't intended for commercial use.
Under the button:
Code:
Private Sub button1_click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim lsdTablepath As String
Dim lsdTablef As String
Dim disptbls As String
Dim tmpPath As String
lsdTablepath = "K:\Shapemaker"
lsdTablef = "SG_LEGALSUBDIVISION"
tmpPath = "C:\TempM"
disptbls = "K:\Shapemaker\2007MinGIS.accdb"
'clear out the old files
'if none exist this will throw an error - ignore it!
On Error Resume Next
Kill(tmpPath + "\*.*")
Call MakeSearchBook(tmpPath, "test.dbf", disptbls)
MessageBox.Show("Done")
End Sub
Code:
Public Sub MakeSearchBook(ByVal pFolder As String, ByVal fName As String, ByVal dbtoOpen As String)
Dim accObj As Microsoft.Office.Interop.Access.Application
Dim strSQL As String
Dim target_path As String
Dim target_dbf As String
Dim tbl As dao.TableDef
Dim tbldefs As dao.TableDefs
Dim objectExists As Boolean
On Error GoTo ErrorHandler ' Run away if something goes wrong...
'
accObj = CreateObject("Access.Application")
accObj.Visible = True
accObj.OpenCurrentDatabase(dbtoOpen)
If UCase(Dir(pFolder + "\" + fName)) = UCase(fName) Then
Kill(pFolder + "\" + fName) ' Cannot overwrite existing table.
End If
strSQL = A valid SQL string
accObj.CurrentDb.Execute(strSQL)
objectExists = False
For Each tbl In accObj.CurrentDb.TableDefs ' You can't overwrite an existing table unless ...
If tbl.Name = "tbltmpNewMinLands" Then
objectExists = True
End If
Next tbl
If objectExists Then
accObj.CurrentDb.TableDefs.Delete("tbltmpNewMinLands") ' ... you get rid of it first.
objectExists = False
End If
' Now make a new tbltmpNewMinLands
strSQL = A different valid SQL make table query
accObj.CurrentDb.Execute(strSQL)
Dim tdf As dao.TableDef
Dim fld As dao.Field
Dim rs As dao.Recordset
Dim qdf As dao.QueryDef
Dim PPIDVal As String
Dim PPIDOldVal As String
Dim Counter As Long
Dim FieldExists As Boolean
tdf = accObj.CurrentDb.TableDefs("tbltmpNewMinLands")
For Each fld In tdf.Fields
If fld.Name = "Counter" Then
FieldExists = True
Exit For
End If
Next
If Not FieldExists Then
[COLOR=Red] tdf.Fields.Append(tdf.CreateField("Counter", dao.DataTypeEnum.dbInteger, 12))[/COLOR]
End If
strSQL = "SELECT * FROM tbltmpNewMinLands;"
rs = accObj.CurrentDb.OpenRecordset(strSQL)
PPIDOldVal = ""
Do While Not rs.EOF
PPIDVal = rs.Fields("lands").Value
If PPIDVal <> PPIDOldVal Then
Counter = 1
PPIDOldVal = PPIDVal
Else
Counter = Counter + 1
PPIDOldVal = PPIDVal
End If
With rs
.Edit()
.Fields("Counter").Value = Counter
.Update()
.MoveNext()
End With
Loop
rs.Close()
fld = Nothing
tdf = Nothing
'accObj.CloseCurrentDatabase()
accObj.Quit()
accObj = Nothing
Exit Sub
ErrorHandler: ' ... but give a clue as to what went wrong.
MsgBox("Error number " & Err.Number & ": " & Err.Description)
'accObj.CloseCurrentDatabase()
accObj.Quit()
accObj = Nothing
End Sub
The line in red above strikes me as the possible culprit, in VBA an Integer is a 2 byte number, in vb.net a long is a 4 byte number. Try changing it to dbLong
I gave that a try too and while it may be contributing to the problem, I am still having the memory problem, Error 7.
I thought that perhaps I was doing too much at once so I made the table for updating and tried to run just the last part. Same error.
Running the query "SELECT * FROM tbltmpNewMinLands" still runs OK.
Recordset creation with rs = accObj.CurrentDb.OpenRecordset(strSQL) also works OK. It reads the first value of the field "lands" OK. The value is correct.
This starts OK.
With rs
.Edit()
.Fields("Counter").Value = Counter
.Update()
.MoveNext()
End With
The value of Counter is correct, and the right type, Long, but as soon as it tries to assign it to value property in Fields("Counter") it craps with Error 7. Like I said at the beginning, the same code works under vba. So I don't understand the memory issue.
