I'm using ADO 2.1 in MS Access 2003 and calling the AddNew method of an ADO recordset using an array of field names and an array of values. I am getting no error messages however, the record is not being written to the table.
I have tried following the command with a .Update and a .Requery to no avail.
Any ideas?
Public Function ReadFileViaTextStream(ByVal PortfolioName As String, ByVal SourceFile As String, ByVal TargetTable As String, _
ByRef TargetFields(), ParamArray SourceFields() As Variant)
Dim p_adoRS As ADODB.Recordset
Dim ForWriting() As Variant
Set p_adoRS = New ADODB.Recordset
p_adoRS.Open TargetTable, CurrentProject.Connection, adOpenDynamic, adLockBatchOptimistic, adCmdTable
If p_adoRS.Supports(adAddNew) Then
p_adoRS.AddNew TargetFields(), ForWriting()
p_adoRS.Update
p_adoRS.Requery
End If
TargetTable is a string parameter, TargetFields is an array of field names and ForWriting is an array of values.
Right - Myself and a colleague have found the issue. The recordset should be opened as adLockOptimistic, not adLockBatchOptimistic.
Related
I am currently trying to upgrade an old ADP project from Access 2010 x64 to Access 2019 x64. I have managed to convert it to an .accdb file, but are now running into errors with my VBA code.
Please consider the following function:
Public Function GetSystemSetting(sKey As String, vValue As Variant) As Boolean
Dim cnTemp As ADODB.Connection, rsTemp As ADODB.Recordset
Dim sSQL As String
On Error GoTo LAB_Error
sSQL = "SELECT T_Value FROM INT_SystemSettings WHERE (T_Key = '" & sKey & "')"
Set cnTemp = New ADODB.Connection
Set rsTemp = New ADODB.Recordset
cnTemp.CursorLocation = adUseServer
cnTemp.Open CurrentProject.BaseConnectionString
rsTemp.Open sSQL, cnTemp, adOpenForwardOnly, adLockReadOnly
If (rsTemp.EOF) Then GoTo LAB_Error
vValue = Nz(rsTemp![T_Value])
rsTemp.Close
cnTemp.Close
On Error GoTo 0
GetSystemSetting = True
Exit Function
LAB_Error:
vValue = Null
If (rsTemp.State <> adStateClosed) Then rsTemp.Close
If (cnTemp.State <> adStateClosed) Then cnTemp.Close
GetSystemSetting = False
End Function
I know that this code is questionable in many aspects, but would like to focus on the line
vValue = Null
When this line gets executed, a runtime error is raised:
Invalid use of Null
I have read dozens of articles about that error message on various sites, including this one, but it always boiled down to that the OP hadn't made the destination variable a variant. But in my case, the destination variable, vValue, is of type variant. Furthermore, that code ran since 8 years without any problem in Access 2010 x64.
What is the reason for that error, and how can I prevent it?
It is important to remember that with functions like this:
Public Function GetSystemSetting(sKey As String, vValue As Variant) As Boolean
vValue = Null
unless you specify ByVal, the parameters are passed ByRef, and so you are actually writing to the variable that is used as parameter when calling the function.
If that variable isn't a variant, the error is triggered.
Dim str As String
If GetSystemSetting("non-existing", str) Then ' KA-BOOM!
An alternative with DLookup would be the following. It should behave exactly the same, unless you have valid SystemSettings that are NULL.
Public Function GetSystemSetting(sKey As String, vValue As Variant) As Boolean
' DLookup returns NULL if no record is found
vValue = DLookup("T_Value", "INT_SystemSettings", "T_Key = '" & sKey & "'")
GetSystemSetting = Not IsNull(vValue)
End Function
DLookup is a read-only operation, so it should be the same regarding locking.
I've looked all over the place for this and I can't find it; I looked in ADO, and DAO.
Is there a way using VBA to edit the row source property of a combo box on a form in another .mdb file? I have to make this change on a bunch of .mdb files and I'd rather use a script to do it, than to do it one at a time.
Use COM automation to create an Access application session where you open a database, open the target form in design mode, and then alter the target combo box's Row Source.
Public Sub AlterComboRowSource(ByVal pDb As String, _
ByVal pForm As String, _
ByVal pCombo As String, _
ByVal pRowSource As String, _
Optional ByVal pEdit As Boolean = False)
Dim objAccess As Access.Application
Dim frm As Form
Dim cbo As ComboBox
Set objAccess = New Access.Application
objAccess.Visible = True '<- useful while debugging
objAccess.OpenCurrentDatabase pDb, True
objAccess.DoCmd.OpenForm pForm, acDesign
Set frm = objAccess.Forms(pForm)
Set cbo = frm.Controls(pCombo)
Debug.Print cbo.RowSource
If pEdit = True Then
cbo.RowSource = pRowSource
objAccess.DoCmd.Close acForm, pForm, acSaveYes
End If
objAccess.Quit acQuitSaveNone
End Sub
Here is my test procedure, which demonstrates how to use the first procedure:
Public Sub test_AlterComboRowSource()
Const cstrCombo As String = "cmbEmployeeName"
Const cstrForm As String = "frmLogin"
Dim strDbPath As String
Dim strSelect As String
strDbPath = "C:\Users\hans\Documents\Access\Scratch.accdb"
strSelect = "SELECT e.EmployeeID, e.FirstName & ' ' & e.LastName AS [Employee Name] " & _
"FROM tblEmployees AS e " & _
"WHERE e.Inactive=False ORDER BY 2;"
AlterComboRowSource strDbPath, cstrForm, cstrCombo, strSelect, True
End Sub
Those procedures worked as intended when I tested them in Access 2010.
It should be more efficient to do Set objAccess = New Access.Application just once, and then re-use objAccess, opening each of your databases, altering the combo Row Source, and then closing the database.
However since this may be a one-off situation, perhaps you don't care much about execution speed.
I am building a function with a set of supporting sub-functions to create ADOX.Catalog objects to help me build automation for Access database generation.
I like to use late-binding for my applications because my user base doesn't always have the same version of office applications, so I can't always rely on them having the same versions of the libraries I'm calling.
My public function accepts several objects as parameters, but I need to make sure they're actually ADODB.Recordset objects before I start processing them. I referred to the msdn article at https://msdn.microsoft.com/en-us/library/s4zz68xc.aspx to get started, and I'm trying to use If TypeOf ... Is ADODB.Recordset per the article's recommendation, but it generates the following error:
Compile error:
User-defined type not defined
Here is a snippet of my code. The first offending line is TypeOf adoRsColumns Is ADODB.Recordset:
Public Function ADOX_Table_Factory( _
ByVal strTblName As String, _
Optional ByVal adoRsColumns As Object, _
Optional ByVal adoRsIndexes As Object, _
Optional ByVal adoRsKeys As Object _
) As Object
'Init objects/variables.
Set ADOX_Table_Factory = CreateObject("ADOX.Table")
'Begin interactions with the new table object.
With ADOX_Table_Factory
.Name = strTblName
'Check if we've received an ADO recordset for the column(s).
If TypeOf adoRsColumns Is ADODB.Recordset Then
'Check that the recordset contains rows.
If Not (adoRsColumns.BOF And adoRsColumns.EOF) Then
'Loop through the column definitions.
Do
.Columns.Append ADOX_Column_Factory(adoRsColumns.Fields(0), adoRsColumns.Fields(1), adoRsColumns.Fields(2), adoRsColumns.Fields(3))
Loop Until adoRsColumns.EOF
End If
End If
My Googling has not yielded any results that have helped me get around this error. I have confirmed this code works if I set a reference to the ADO library. I have also confirmed, via the TypeName function, that the objects are identified by name as Recordset. If I replace TypeOf adoRsColumns Is ADODB.Recordset with TypeOf adoRsColumns Is Recordset, however, then the test evaluates false and the desired code doesn't execute. I haven't resorted to a string comparison to TypeName's output because, as stated in the MSDN article, TypeOf ... Is is faster.
Thanks in advance for any assistance!
Just to recap, without an ADO reference included in your project, you get a compile error at this line:
If TypeOf adoRsColumns Is ADODB.Recordset Then
Without the reference, VBA doesn't recognize ADODB.Recordset The situation is basically the same as if you tried to declare Dim rs As ADODB.Recordset without the reference. That declaration would trigger the same compile error.
There is no way to use ADODB.Recordset as a recognized type without the reference.
As an alternative approach, you could create a custom function to check whether the object supports a method or property which is available in an ADODB.Recordset but not in a DAO.Recordset
This one checks whether the recordset includes a Supports method. That method is available in an ADODB but not DAO Recordset.
Public Function IsAdoRecordset(ByRef pObject As Object) As Boolean
Const adAddNew As Long = 16778240
Dim lngTmp As Long
Dim blnReturn As Boolean
Dim strMsg As String
On Error GoTo ErrorHandler
blnReturn = False
If TypeName(pObject) = "Recordset" Then
lngTmp = pObject.Supports(adAddNew)
blnReturn = True
End If
ExitHere:
On Error GoTo 0
IsAdoRecordset = blnReturn
Exit Function
ErrorHandler:
Select Case Err.Number
Case 438 ' Object doesn't support this property or method
' leave blnReturn = False
Case Else
' notify user about any other error
strMsg = "Error " & Err.Number & " (" & Err.Description _
& ") in procedure IsAdoRecordset"
MsgBox strMsg
End Select
Resume ExitHere
End Function
I have tried many ways to get the job done. I am inexperienced with the
Access VBA.
I think the problem is how to set the current database. The code is in a module from another db as the current db. I have paste the code here in a module behind the
currentdb that also gives the same error. I have looked after very much questions.
It must be simple. But I don't see the answer.
Private Sub project()
Dim projectnamen As DAO.Database
Dim strSQL As String
Dim rs As DAO.Recordset
Dim strdbName As String
Dim strMyPath As String
Dim strdb As String
Dim accapp As Object
Path = "c:\GedeeldeMappen\programma en bestanden stiko"
strdbName="projektnamen.accdb"
strMyPath = Path
strdb = strMyPath & "\" & strdbName
'make the db "projectnamen"current. Perhaps this is possible with set??
Set accapp = CreateObject("Access.Application")
accapp.OpenCurrentDatabase (strdb)
'fieldname is naam_van_het_project
'tablename is projectnaam
strSQL = "SELECT All naam_van_het_project FROM projectnaam;"
'here i get an error "can't find the object Select All naam_van_het_project
'FROM projectnaam" error 3011
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenTable)
rs.MoveFirst
Do While Not rs.EOF
MsgBox (rs)
rs.MoveNext
Loop
End Sub
I think you want to run that query against the db which you opened in the new Access session, accapp.
The CurrentDb method is a member of Application. So qualify CurrentDb with the object variable name of that other application session.
'Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenTable)
Set rs = accapp.CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
Note OpenRecordset won't let you use dbOpenTable with a query. So I arbitrarily chose dbOpenSnapshot instead. If that's not what you want, substitute a different constant from the RecordsetTypeEnum Enumeration (see Access help topic for details).
Right now, I've got a database that allows a user to create a basic report based on a query from a table using a parameter. Pretty straightforward. What I want to do now is to use VBA to add a record into a separate table every time a report is created. Each report has the information from the query PLUS some new information (concatenated IDs, dates, etc.). The new table ("Summary") would include some of that new information plus a few sources from the original query. It would be sort of a dynamic log of reports created.
Is there any way to use VBA to combine data from the two sources (data displayed on report from original query and native report data) into one record on a table?
Here's the code I've got so far.
Option Compare Database
Public Sub Log_Report()
'System definitions
Dim dbs As DAO.database
Dim rs As DAO.Recordset
Dim rep As [Report_Custom MARS Report]
'Original report sources
Dim Text267 As String
Dim TableName As String
Dim Company_Name As String
Dim ReportID As String
'Summary table destination
Dim ID As Integer
Dim Date_Created As Date
Dim Source As String
Dim Title As String
Dim report_ID As String
Dim Attachment As Attachment
End Sub
I'm probably way off, so if I have to start over, I'm fine with that. I'm no expert in VBA by any means, so it's been a lot of trial and error so far.
I can clarify if needed.
If the record set for your report is a single row, it would be relatively easy to use the on load event to read the fields and assign them to variables. All of the calculations have been done by the time your Report_Load event fires and you could then use them as inputs to a function which writes the values to your summary table.
'Code to placed in a public function
'strVar = text267 'is ReportID = report_ID ?
'Unfortunately I have no experience with attachments, sorry
function writeReportSummary(intID as Integer, dtmDate_Created as Date, strSource as String, strTitle as string, strReportID as string, strVar as string, strTableName as string, strCompanyName as string, attAttachment as attachment) AS boolean
Dim strSQL as string
On error goto Err_Handler
strSQL = "INSERT INTO summary( ID, Date_Created, Source, Title, report_ID, Text267, tableName, Company_Name, ReportID) SELECT """ & intID & """ , """ & dtmDate & """;" 'etc
CurrentDb.execute strSQL, dbFailOnError
Debug.print CurrentDB.recordsAffected & ": Record(s) Inserted at " & now()
writeReportSummary = True
Exit function
Err_Handler:
debug.print err.number
debug.print err.description
writeReportSummary = false
end function
'Code to be placed in Report_load'
Sub Report_Load
if Not(writeReportSummary(intID, dtmDate, etc)) then debug.print "Failed to write report to summary table"
End Sub