I created a listbox and connected it to a table. I wrote the following code to go to record I choose from the listbox. My problem is that when I click on the listbox and code gets to "Me.Bookmark = rst.Bookmark" command (at a break point), the list becomes blank. This is very clear (and ugly) when there is a message to display after this line of code. Any suggestions please?
Private Sub lstFullName_Click()
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
rst.FindFirst "sdtID = " & Me.lstFullName.Column(1)
If Not rst.NoMatch Then
Me.Bookmark = rst.Bookmark
End If
Set rst = Nothing
CheckRecordStatus ' Checks for empty fields and gives warnings.
End Sub
Related
I created a button that when pressed will create an InputBbox to enter an address into a table. Once the address is entered a file number is generated.
The table I created has a File_Number Column that will AutoNumber once the Address is input.
Private Sub Command39_Click()
Dim dbsFileGen As DAO.Database
Dim NewAddress As DAO.Recordset
Dim AddNew As String
Dim FileNum As DAO.Recordset
Dim FileN As Integer
Set dbsFileGen = CurrentDb
Set NewAddress = CurrentDb.OpenRecordset("dbo_File_Generator", dbOpenDynaset, dbSeeChanges)
Set FileNum = CurrentDb.OpenRecordset("dbo_File_Generator", dbOpenDynaset, dbSeeChanges)
AddNew = InputBox("Please enter the building address.")
NewAddress.AddNew
NewAddress!Address = AddNew
NewAddress.Update
End Sub
I tried the .MoveLast Function to display the last number in the table however it shows the second to last number.
Ok, since this is only ONE column value, then the inputbox idea is ok. (but, for any more fields, you would want to pop up a data entry form as "dialog".
Ok, so the code has to do TWO steps:
add the row - save it
THEN get/grab the new auto number ID column
So, code should and would look like this:
Sub AddOneSQL()
Dim AddNew As String
AddNew = InputBox("Please enter the building address.")
If AddNew = "" Then
' user did not enter anything - exit the routine - bail out
Exit Sub
End If
' if we get here, then user did enter somthing, so we NOW start our data
' operations code. (don't start before the input box, since what then if
' user does not enter, or hits cancel - we bail out as per above.
Dim NewAddress As DAO.Recordset
Dim MyNewRowPK As Long
Set NewAddress = CurrentDb.OpenRecordset("dbo_File_Generator", dbOpenDynaset, dbSeeChanges)
NewAddress.AddNew
NewAddress!Address = AddNew
NewAddress.Update ' this will generate the new auto number id
' now get autonubmer ID - unfortantly DAO has the nasty feature (only when addding)
' that .Update will cause the record poitner to move off (not valid), so we move back
NewAddress.bookMark = NewAddress.LastModified
MyNewRowPK = NewAddress("ID") ' replace "id" with your autonumber column name
NewAddress.Close
MsgBox "new autonumber id = " & MyNewRowPK
End Sub
I have a MS Access file and it has a form with a button which export a named query to a CSV file. When i open the CSV to Excel, a column with lengthy text with line breaks get cuts off. When i tried to copy and then paste special as CSV on the Excel it turns out to be fine.
Here is my VBA code
Public Sub exportQuery(exportSQL As String)
Dim db As DAO.Database, qd As DAO.QueryDef
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogSaveAs)
Set db = CurrentDb
'Check to see if querydef exists
For i = 0 To (db.QueryDefs.Count - 1)
If db.QueryDefs(i).Name = "tmpExport" Then
db.QueryDefs.Delete ("tmpExport")
Exit For
End If
Next i
Set qd = db.CreateQueryDef("tmpExport", exportSQL)
'Set intial filename
fd.InitialFileName = "export_" & Format(Date, "mmddyyy") & ".csv"
If fd.Show = True Then
If Format(fd.SelectedItems(1)) <> vbNullString Then
DoCmd.TransferText acExportDelim, , "tmpExport", fd.SelectedItems(1), False
End If
End If
'Cleanup
db.QueryDefs.Delete "tmpExport"
db.Close
Set db = Nothing
Set qd = Nothing
Set fd = Nothing
End Sub
And this for command button to call the function
Private Sub Command0_Click()
Dim queryStr As String
'Store Query Here:
queryStr = "SELECT [Name],[Notes] FROM [GetListForUpload]"
Call exportQuery(queryStr)
End Sub
Can someone help me with this?
I solved my own problem haha! So i just want to share this for any other who stumbled from this situation. Their's this hidden system objects that you want to show up in navigation options. So first is you check to show the hidden system objects in the navigation options and you will see tables that is greyed out ex.(MSysIMEXColumns, MSysIMEXSpecs) then create a specification. Open the table MSysIMEXColumns, you will see all of the field names on the specification you've created. So on my part i have Notes column which contains lenghty texts with linebreaks. In the MsysIMEXColumns table, I changed the DataType for the fieldname Notes from 10 (Text) to 12 (Memo) and voila. No lenghty texts get cuts off or truncated anymore :)
PS: If you have more than 1 specifications created please identify the specid first from MSysIMEXSpecs and then check it in MSysIMEXColumns before you changed anything for not to get confused.
The following code is meant to compare a field value PURE_QP1 of a recordset to another field value PURE_QP1 of another second set. But i am getting end of statement expected error. My knowledge of Access vba is admittedly low.
The code is meant to first check if the productcode is present in recordset rst.
if it is, then it checks if it is compliant by finding its PURE_QP1 (which coud be more than 1) in another table. the condition for compliance is such that all its QP1s must be found in the table.
Dim db As DAO.Database
Dim rst As Recordset
Dim rst1 As Recordset
If Nz(Me!Combo_Product_number) <> "" Then
Set db = CurrentDb
Set rst = db.OpenRecordset("Q_compliant_FCM_EU", dbOpenDynaset)
Set rst1 = db.OpenRecordset("T_DOSSIER_FPL", dbOpenDynaset)
Do While Not rst.EOF
If rst.Fields("PRODUCT_CODE") = Me!Combo_Product_number Then
rst1.FindFirst "[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
If rst.NoMatch Then
MsgBox ("Product code is NOT compliant to FPL")
Exit Sub
End If
rst1.FindNext"[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
Loop
MsgBox ("Product code is compliant to FPL")
Else
MsgBox ("Product is not available in FCM_EU")
End If
End If
End Sub
Expected end of staement error is showing in
rst1.FindFirst "[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
and
rst1.FindNext"[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
You have an extra End If just before End Sub. That End If should go above Loop command to close the If rst.Fields("PRODUCT_CODE") = Me!Combo_Product_number Then if block.
Also your code regarding rst1 is wrong.
rst1.FindFirst "[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
should be
rst1.FindFirst "[PURE_QP1] = '" & rst.Fields("PURE_QP1") & "'"
the & sign to join strings are missing in your code.
PS: Have no idea what your code supposed to do, because your find first and find next logic seems to be incorrect.
I've seen a number of posts trying to describe this bug but they haven't framed the problem correctly to be reproduced... or not set the scenario in the way that I've experienced the bug using a common technique.
The bug occurs when a form's recordset is set to a virtual recordset and then referred to by a DAO recordsetclone statement. Instead of the recordset being set to the form's recordset (via cloning), a "Select Data Source" dialog is presented.
We most commonly use this to add a checkbox control to a detail form for a user to select one or more records for further processing. I've used this technique many times in many applications but now it fails.
Note: I have confirmed that this code works correctly in Access 2010.
I'm using Windows 10 Pro with a 32 bit Office installation
To set this up and reproduce the bug:
Create a new ACCDB database
Add the following references to the default references:
Microsoft ActiveX Data Objects 6.1 Library
Microsoft ADO Ext. 2.8 for DDL and Security
Create a testing table:
TestId, AutoNumber, PK
TestText, Short Text
Append about 10 rows to the table.
Create an unbound form with 3 controls:
Checkbox, Name: Selected, Control Source: Selected
Textbox, Name: TestId, Control Source: TestId
Textbox, Name: TestText, Control Source: TextText
In the form's header add a command button: Name: cmdTest, Caption: Test
Set the form Default View: Continuous
In the Form_Open call a sub SetRecordsource which creates a recordset and adds a column "Selected" for the user to check the records they want.
The command button cmdTest will attempt to reference the form's recordsource. It's while attempting to reference the form's recordsouce that the error occurs. Instead of the reference being made, the "Select Data Source" dialog pops up.
The complete form's VBA code:
Option Compare Database
Option Explicit
Private Sub cmdTest_Click()
On Error GoTo errHandler
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
' Using an ADODB recordset works but is an ugly solution
' To test comment out the Dim DAO and Set rs statements above and uncomment the next 2 lines.
' Dim rs As ADODB.Recordset
' Set rs = Me.Recordset
rs.MoveFirst
With rs
Do While Not .EOF
Debug.Print .Fields("Selected"), .Fields("TestId"), .Fields("TestText")
.MoveNext
Loop
End With
Set rs = Nothing
ExitSub:
Exit Sub
errHandler:
MsgBox "Error in " & Me.Name & ".SetRecordsource " & Err.Number & " - " & Err.Description
Resume ExitSub
End Sub
Private Sub SetRecordsource()
Dim rs As ADODB.Recordset 'the virtual recordset to hold the source data plus the boolean Selected field
Dim rsSource As DAO.Recordset 'dim the source recordset
Set rs = New ADODB.Recordset
With rs
.Fields.Append "Selected", adboolean
.Fields.Append "TestId", adInteger, , adFldKeyColumn
.Fields.Append "TestText", adVarChar, 80
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
Set rsSource = CurrentDb.OpenRecordset("Select TestId, TestText from Test", dbOpenDynaset)
rsSource.MoveFirst
Do Until rsSource.EOF
.AddNew
.Fields("Selected") = 0 'set the checkboxes to unchecked
.Fields("TestId") = rsSource.Fields(0)
.Fields("TestText") = rsSource.Fields(1)
.Update
rsSource.MoveNext
Loop
End With
Set Me.Recordset = rs 'Set the form's recordset = to our virtual recordset
Set rsSource = Nothing
Set rs = Nothing
ExitSub:
Exit Sub
err_handler:
MsgBox "Error in " & Me.Name & ".SetRecordsource " & Err.Number & " - " & Err.Description
Resume ExitSub
End Sub 'SetRecordsource
Open the form and click the Test command button to reproduce the error.
One solution proposed is to use an ADODB recordset and set it to Me.Recordset instead of Me.Recordsetclone. While this does work, it's an ugly solution since you are now operating on the form's recordsource and when looping through the records to find the rows where Selected = True moves the current record on the form. Not only does the current record pointer move but if there's more rows then the can show, the user sees the form's records scrolling.
Any help, confirmation or recommendations would be greatly appreciated.
Thanks in advance!
From another forum the solution to this is to use an ADODB recordset and then clone the form to it via Recordset.Clone. In the code above, it references an "ugly" solution:
' Using an ADODB recordset works but is an ugly solution
' To test comment out the Dim DAO and Set rs statements above and uncomment the next 2 lines.
' Dim rs As ADODB.Recordset
' Set rs = Me.Recordset
Setting rs = Me.Recordset will operate on the form (not desired).
But using an ADODB recordset and then
setting rs = Me.Recordset.Clone works, does not operate on the form and doesn't pop up the Data Source Dialog.
Something has changed in 2016 but this does work and may help someone else.
You may also want to read: Create In-Memory ADO Recordsets at Database Journal
Your code can't work, as you try to assign an ADODB.Recordset (the one in Form.Recordset) to a DAO.Recordset,`as it is declared.
If the Recordset-Type can vary, you can dimrs as Objectthen it gets the type of Form.Recordset(by Form Property RecordsetClone, that surprisingly works for ADODB:Recordsets too). You can query the type with:
If TypeOf Me.RecordSet Is ADODB.Recordset Then
'ADODB
Else
'DAO
End If
If you need an unboundCheckBox, you can useclsCCRecordSelect-Class from SelectRecordsV2.
TheclsCCRecordSelectis used by me for years and I don't want to live without!
Option Compare Database
Private rs As Recordset
Private Sub Send_Click()
Dim strLocation As String
If MsgBox("Please confirm you wish to run todays tasks.", vbYesNo) = vbNo Then
Exit Sub
End If
Set rs = Me.RecordsetClone
rs.MoveFirst
Do Until rs.EOF
Debug.Print rs("title")
'Call Update_Progress("Test", rs("ID"))
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Sub
Hello,
Please see the code above.
Can someone advise how I keep the recordset's position when I move between functions/subs.
This code loops through the records fine if I note out the "Update_Progess" Function but when this is in, it continually loops through the first record?
thanks in advance
As in the Comments,
I had a requery of the form in one of the Functions which was causing the recordset reset its position, this was fixed by amending to a refresh.