I made a sub that deletes records in a table via a recordset.
I would like to print the key of the record that is deleted to a textbox on a form.
So after each delete the key has to be added to the textbox on the form.
Below you can find the code, that doesn't print anything to the form.
I'm missing something.
Public Sub Erase()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim strOutput As String
Dim i As Integer
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Table1", dbOpenDynaset) 'dynaset voor linked tables
If rs1.EOF Then Exit Sub
Do Until rs1.EOF
If rs1!Icoon = "del" Then
Debug.Print "Debug Print :" & rs1(0).Value
strOutput = "Ent: " & rs1(0).Value & vbCrLf
On Error Resume Next
rs1.Delete
txtOutput.value = strOutput
i = DoEvents
End If
rs1.MoveNext
Loop
rs1.Close
Set rs1 = Nothing
Set db = Nothing
End Sub
Forgot the form ... txtOutput.value = strOutput should be: [Forms]![Frm_Main]![txtOutput] = strOutput
Related
I am trying to duplicate a form from a button using vba. This has worked for years using Allen Browne's "Duplicate the record in form and subform." http://allenbrowne.com/ser-57.html
Now I want to change one of the fields to multivalue. I understand the difficulties with multivalued fields, but this is a 10 year old database and all I need to do is make this field be able to store multiple values, so think this will be easier than creating a new join table and updating everything related.
I am currently getting Invalid use of Property at the rstmv = rstmv.Value line.
I have tried numerous versions and get different errors. I think I should be opening the values of the multi-value field as a separate recordset, updating it then looping through the values but I am getting confused as I am not really sure what I am doing.
Here is the code I I have been using:
'On Error GoTo Err_Handler
'Purpose: Duplicate the main form record and related records in the subform.
Dim strSql As String 'SQL statement.
Dim lngID As Long 'Primary key value of the new record.
Dim rst As Recordset
Dim rstmv As Recordset2
'Save and edits first
If Me.Dirty Then
Me.Dirty = False
End If
'Make sure there is a record to duplicate.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
'Duplicate the main record: add to form's clone.
With Me.RecordsetClone
.AddNew
!Site_Name = Me.Site_Name
!Date_of_Dive = Me.Date_of_Dive
!Time_of_Dive = Me.Time
Set rst = Me.RecordsetClone
Set rstmv = rst!Staff.Value
Do While Not rstmv.EOF
rsp.Edit
rstmv.Edit
rstmv.AddNew ' Add a new record to the asp Recordset
rstmv = rstmv.Value
rstmv.Update ' Commit the changes to the asp Recordset
imt.MoveNext
Loop
.Update
!O2 = Me.O2
!First_Aid = Me.First_Aid
!Spares = Me.Spares
'etc for other fields.
.Update
'Save the primary key value, to use as the foreign key for the related records.
.Bookmark = .LastModified
lngID = !Dive_Number
'Duplicate the related records: append query.
If Me.[DiveDetailssubform].Form.RecordsetClone.RecordCount > 0 Then
strSql = "INSERT INTO [DiveDetails] (Dive_Number, CustDateID, Type, Price) " & _
"SELECT " & lngID & " As NewID, CustDateID, Type, Price " & _
"FROM [DiveDetails] WHERE Dive_Number = " & Me.Dive_Number & ";"
DBEngine(0)(0).Execute strSql, dbFailOnError
Else
MsgBox "Main record duplicated, but there were no related records."
End If
'Display the new duplicate.
Me.Bookmark = .LastModified
MsgBox "Dive Sucessfully Duplicated. DONT FORGET TO CHANGE THE SITE NAME."
End With
End If
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, , "Duplicate_Click"
Resume Exit_Handler
End Sub
Private Sub Form_Load()
Dim varID As Variant
Dim strDelim As String
'Note: If CustomerID field is a Text field (not a Number field), remove single quote at start of next line.
'strDelim = """"
varID = DLookup("Value", "tblSys", "[Variable] = 'DiveIDLast'")
If IsNumeric(varID) Then
With Me.RecordsetClone
.FindFirst "[dive_number] = " & strDelim & varID & strDelim
If Not .NoMatch Then
Me.Bookmark = .Bookmark
End If
End With
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim rs As DAO.Recordset
If Not IsNull(Me.Dive_Number) Then
Set rs = CurrentDb().OpenRecordset("tblSys", dbOpenDynaset)
With rs
.FindFirst "[Variable] = 'DiveIDLast'"
If .NoMatch Then
.AddNew 'Create the entry if not found.
![Variable] = "DiveIDLast"
![Value] = Me.Dive_Number
![Description] = "Last DiveID, for form Dive Planner" & Me.Name
.Update
Else
.Edit 'Save the current record's primary key.
![Value] = Me.Dive_Number
.Update
End If
End With
rs.Close
End If
Set rs = Nothing
End Sub
Need recordsets of source data and recordsets for destination. Also should explicitly declare the recordset type as DAO. Consider:
Dim strSql As String 'SQL statement.
Dim lngID As Long 'Primary key value of the new record.
Dim rstF As DAO.Recordset
Dim rstT As DAO.Recordset
Dim rstmvF As DAO.Recordset2
Dim rstmvT As DAO.Recordset2
'Save any edits first
If Me.Dirty Then
Me.Dirty = False
End If
'Make sure there is a record to duplicate.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else
Set rstF = CurrentDb.OpenRecordset("SELECT * FROM Dives WHERE Dive_Number = " & Me.Dive_number)
Set rstmvF = rstF!Staff.Value
'Duplicate the main record: add to form's clone.
With Me.RecordsetClone
.AddNew
!Site_Name = Me.Site_Name
!Date_of_Dive = Me.Date_of_Dive
!Time_of_Dive = Me.Time
!O2 = Me.O2
!First_Aid = Me.First_Aid
!Spares = Me.Spares
.Update
'Save the primary key value of new record.
.Bookmark = .LastModified
lngID = !Dive_number
Set rstT = CurrentDb.OpenRecordset("SELECT * FROM Dives WHERE Dive_Number = " & lngID)
Set rstmvT = rstT!Staff.Value
rstT.Edit
Do While Not rstmvF.EOF
rstmvT.AddNew ' Add a new record to the asp Recordset
rstmvT!Value = rstmvF!Value
rstmvT.Update ' Commit the changes to the asp Recordset
rstmvF.MoveNext
Loop
rstT.Update
I have created a form to get all the field header names, but I'm unable to select multiple fields. Attached is for your reference.
Following is the code used to get the Headers from the Master Table:
Private Sub Form_Load()
'Call GetColumnNameFromIndex
'Call List4_Click
Dim rst As New ADODB.Recordset
rst.Open "SELECT * FROM Master_DataBase", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
' Note: adOpenForwardOnly and adLockReadOnly are the default values '
' for the CursorType and LockType arguments, so they are optional here '
' and are shown only for completeness '
Dim ii As Integer
Dim ss As String
For ii = 0 To rst.Fields.Count - 1
ss = ss & "," & rst.Fields(ii).Name
Next ii
Me.List4.RowSource = ss
Debug.Print ss
Me.Requery
End Sub
Set your properties to Simple or Extended.
Sample VBA code may look like this.
Option Compare Database
Private Sub cmdOpenQuery_Click()
On Error GoTo Err_cmdOpenQuery_Click
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strIN As String
Dim flgSelectAll As Boolean
Dim varItem As Variant
Set MyDB = CurrentDb()
strSQL = "SELECT * FROM tblCompanies"
'Build the IN string by looping through the listbox
For i = 0 To lstCounties.ListCount - 1
If lstCounties.Selected(i) Then
If lstCounties.Column(0, i) = "All" Then
flgSelectAll = True
End If
strIN = strIN & "'" & lstCounties.Column(0, i) & "',"
End If
Next i
'Create the WHERE string, and strip off the last comma of the IN string
strWhere = " WHERE [strCompanyCountries] in (" & Left(strIN, Len(strIN) - 1) & ")"
'If "All" was selected in the listbox, don't add the WHERE condition
If Not flgSelectAll Then
strSQL = strSQL & strWhere
End If
MyDB.QueryDefs.Delete "qryCompanyCounties"
Set qdef = MyDB.CreateQueryDef("qryCompanyCounties", strSQL)
'Open the query, built using the IN clause to set the criteria
DoCmd.OpenQuery "qryCompanyCounties", acViewNormal
'Clear listbox selection after running query
For Each varItem In Me.lstCounties.ItemsSelected
Me.lstCounties.Selected(varItem) = False
Next varItem
Exit_cmdOpenQuery_Click:
Exit Sub
Err_cmdOpenQuery_Click:
If Err.Number = 5 Then
MsgBox "You must make a selection(s) from the list", , "Selection Required !"
Resume Exit_cmdOpenQuery_Click
Else
'Write out the error and exit the sub
MsgBox Err.Description
Resume Exit_cmdOpenQuery_Click
End If
End Sub
Please customize to your specific needs.
I have a first table called "BreedingTable" with primary key "ID" and "TransactionStatus" = "Active".
I have "Kidding form" data populated from the combo box to Text fields
Text2.value = "ID" from BreedingTable.
When I am done with all the process, I want to change TransactionStatus of Breeding table = Closed.
I am using the below code but it never works.
Note" if I give exact transaction id number it works fine,
but if I ask to find based on text2 it doesn't work.
My code is as follows:
Private Sub exitprograme3()
Me.Text2.SetFocus
Dim i As Integer
Dim db As Database
Dim rs As Recordset
Dim Trn As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("BreedingTable")
For i = 0 To rs.RecordCount - 1
Me.Text2.SetFocus
If rs.Fields("ID") = Me.Text2.Value Then
rs.Edit
rs.Fields("BreedingStatus") = "Closed"
rs.Update
End If
rs.MoveNext
Next i
rs.Close
Set rs = Nothing
db.Close
DoCmd.Close
End Sub
Please assist ...
If I type exact transaction id number in below if statement it works
If rs.Fields("ID") = "323" Then
this works fine.
But if I type like below it doesn't work
If rs.Fields("ID") = Me.Text2.Value Then
No loop is needed:
Private Sub exitprograme3()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Select * From BreedingTable")
rs.FindFirst "[ID] = " & Me!Text2.Value & ""
' If ID is text, then quotes:
' rs.FindFirst "[ID] = '" & Me!Text2.Value & "'"
If Not rs.NoMatch Then
rs.Edit
rs.Fields("BreedingStatus").Value = "Closed"
rs.Update
End If
rs.Close
Set rs = Nothing
Set db = Nothing
DoCmd.Close
End Sub
In Access 2007 I need to select all the short-text fields in a table.
VBA code should look like this:
Dim strClient As String
Set dbs = CurrentDb()
Debug.Print Me.ID
strClient = "Select * from ANG_CLIENTS where DATA_TYPE='TEXT' AND ID=" & Me.ID
Set rs = dbs.OpenRecordset(strClient)
I get "Runtime error 3061. Too few parameters. Expected 1" on the last assignment.
You need to define a custom function to loop through the recordset fields and extract the names of text fields only.
The names can then be added to your SQL script.
Public Function TextDataFileds(rs As DAO.Recordset) As String
Dim fld As DAO.Field, item As String
For Each fld In rs.Fields
If fld.Type = 10 Then 'dbText
item = IIf(Len(item) = 0, fld.Name, item & ", " & fld.Name)
End If
Next fld
TextDataFileds = item
End Function
You can then call it like this:
Sub Test()
On Error GoTo ErrProc
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT TOP 1 * FROM ANG_CLIENTS;")
Dim sql_ As String
sql_ = "SELECT " & TextDataFileds(rs) & " FROM ANG_CLIENTS WHERE ID=" & Me!ID
rs.Close
Set rs = Nothing
Set rs = CurrentDb().OpenRecordset(sql_)
'....
Leave:
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
how can i Integration all texts from a column in a form to a textBox ?
this code can add all text from table to textbox in form
Set db = CurrentDb
Set rs = db.OpenRecordset("names")
For i = 1 To rs.RecordCount
text1.SetFocus
text1.Text = text1.Text & " " & rs(1)
rs.MoveNext
Next i
is it any way to add all text from Fields in form in to textbox in same form?
Replace your sub com1_Click with following block. Hope this helps . . .
Private Sub com1_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strNames As String
Dim strSQL As String
' Following line gets the query of the form
strSQL = Me.RecordSource
' Alternatively, you can replace this line with your own select query
' For eg.
' strSQL = "Select * from Table1 Where [_ID] In (1,2)"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
strNames = ""
'Following loop is for going through all the records
While Not rs.EOF
'Following line is for collecting values of Name1 Field of your table
strNames = strNames & " " & rs("Name1")
rs.MoveNext
Wend
' Populating the textbox with values collected from your table
text3 = Trim(strNames)
' Final cleanup
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
Loop through all the controls in the form and put it in a string variable (or a textbox).
Dim cControl As Control
Dim sNames As String
sNames = ""
For Each cControl In Me.Controls
If TypeName(cControl) = "TextBox" Then
sNames = sNames + " " + cControl
End If
Next cControl