I have a button on my form whenever I click on it, it creates several records including a column named: [Aantal], if aantal says 5, it will create 5 records. This column is also as a textbox named [Aantal] on the form.
After the records are created it goes to the last record as shown here:
DoCmd.GoToRecord acDataForm, "GeleidelijstForm", acLast
Is it possible to make it navigate to the first record of those 5 created?
So not the very first record in the table, but the first of those just created. For example if [Aantal] is 5, make it go back 4 records, that way it will be on the first of the 5 records it just created.
Edit:
I have something like this that goes to the latest record, now I want it to go to the first record instead:
pgn = Me.CurrentRecord
t1 = Nz(Me.Aantal, 1)
If t1 > 1 Then
t2 = pgn + t1 - 1
You can also use acPrevious and acNext instead of acLast. See: AcRecord enumeration (Access). But you must make the calculation of how many times you must move to get to the desired record yourself. Access does not know which records you've just created.
Dim t1 As Long, i As Long
t1 = Clng(Nz(Me.Aantal, 1))
DoCmd.GoToRecord acDataForm, "GeleidelijstForm", acLast
For i = 1 To t1 - 1
DoCmd.GoToRecord acDataForm, "GeleidelijstForm", acPrevious
Next i
Or you can directly jump to it with
Dim rs As DAO.Recordset
Dim t1 As Long, numRecords As Long
t1 = Clng(Nz(Me.Aantal, 1))
Set rs = Me.RecordsetClone
rs.MoveLast
numRecords = rs.RecordCount
rs.Close
DoCmd.GoToRecord acDataForm, "GeleidelijstForm", acGoTo, numRecords - t1 + 1
You can also jump to a specific record like this in case you are able to identify the record by some value
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[MyID] = " & theId
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
rs.Close
You can use the RecordsetClone and loop backwards a number of times. Something like:
Private Sub cmdPos_Click()
On Error GoTo E_Handle
Dim rs As DAO.Recordset
Dim lngLoop1 As Long
Dim lngCount As Long
lngCount = Me!txtPos - 1
Set rs = Me.RecordsetClone
rs.MoveLast
If lngCount > 0 Then ' if only one record added then no need to loop
For lngLoop1 = 1 To lngCount
rs.MovePrevious
Next lngLoop1
End If
Me.Bookmark = rs.Bookmark
sExit:
On Error Resume Next
Set rs = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "cmdPos_Click", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Related
Here is the full code:
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim frm As Access.Form
Dim i As Long
'For readability
Set frm = Forms!Frm_JobTicket
'Open Tbl_Schedule for adding Schedule Dates
Set db = CurrentDb
Set rs = db.OpenRecordset("Tbl_Schedule", dbOpenDynaset, dbAppendOnly)
'Creates loop for fields 1-14. Sets Date_ScheduledX = Forms!Frm_JobTicket!Txt_DateScheduledX. Runs through Loop then closes recordset
rs.AddNew
For i = 1 To 14
If (Not IsNull(frm("Txt_DateScheduled" & i & "_JobTicket"))) Then
rs("Date_Scheduled" & i) = frm("Txt_DateScheduled" & i & "_JobTicket")
End If
Next i
'Adds in Sales Order Number to Tbl_Schedule
rs!Sales_Order_Number = frm("Sales_Order_Number")
'Adds in Part Number to Tbl_Schedule
rs!Part_Number = frm("Part_Number")
'Adds updates and closes table
rs.Update
rs.Close
'Shows message box to inform the User if item was Scheduled
MsgBox "Item Scheduled."
'Runs Private Sub above. Clears all values from DateScheduled1-14 on Frm_JobTicket to null
ClearFields
'Clears DB and RS to null
Set db = Nothing
Set rs = Nothing
The line that doesn't work is this rs("Date_Scheduled" & i) = frm("Txt_DateScheduled" & i & "_JobTicket"). Sometimes it will run perfectly fine, and other times it gives me an endless flow of 3421 Data type conversion errors. I do not know what could be going wrong, none of the fields have default values, all of the fields in the table side are Date/Time with this same format, and now I am checking for nulls.
Any help would be greatly appreciated!!
Maybe something like
If Len(Me.Txt_DateScheduled & vbNullString) > 0 Then
rs("Date_Scheduled" & i) = frm("Txt_DateScheduled" & i & "_JobTicket")
Else
rs("Date_Scheduled" & i) = ""
End If
This is completely untested, but I think you should get the concept.
I am trying to use recordset code to loop through all the fields in a table and debug.print their values and field names in an order you would naturally read the table ie from left to right across columns then onto the row below
I have accomplished what I'm trying to do but only for the first row. This is the code:
Sub RecordSets()
Dim db As Database
Dim rs As Recordset
Dim i As Long
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl1")
For i = 0 To rs.Fields.Count - 1
Debug.Print rs.Fields(i).Name
Debug.Print rs.Fields(i).Value
Next
rs.Close
db.Close
End Sub
Immediate window produces following result:
Category
Clothing
Item
Shirt
Price
5
This is the top row and is exactly as I want. But I cannot get any code to work accomplish this exact same thing for the other rows. I am 99% sure I need to use a Do Until .EOF loop in conjunction with the For...Next loop but I can't get the results whatever I try or I lock access up in an infinite query.
Thanks for your help
Untested:
Sub RecordSets()
Const SEP as String = vbTab
Dim db As Database
Dim rs As Recordset, numFlds As Long
Dim i As Long, s As String, sp as string
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl1")
numFlds = rs.Fields.Count
'print the headers (field names)
For i = 0 To numFlds - 1
s = s & sp & rs.Fields(i).Name
sp = SEP '<< add separator for subsequent items
Next
Debug.Print s
'print the data
sp = "" '<< clear the separator
Do While Not rs.EOF
For i = 0 To numFlds - 1
s = s & sp & rs.Fields(i).Name
sp = SEP
Next
Debug.Print s
rs.MoveNext
Loop
rs.Close
db.Close
End Sub
I am currently struggling with this piece of Code:
While receiver = data.Fields("Contact")
If first Then
first = False
strSig = Replace(strSig, ID, data.Fields("ID") & ID)
Else
strSig = Replace(strSig, ID, ", " & data.Fields("ID") & ID)
End If
data.MoveNext
Wend
It is not reading the last database entry.
My complete code is doing the following:
Read Database
Read an HTML File
Search for multiple IDs for a person and aggregate those
Replace the IDs with a placeholder in the IDs
Send the Email
The process does work except for for the last entry. For that entry I receive a
3021 Run Time Error - No Current Record.
Here is an example of how to loop through a recordset:
Option Explicit
Sub recordsetDemo()
'can use the name of a table or of a query, or a specific SQL query:
Const rs_Source = "select * from tblYourTable"
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(rs_Source) 'open the recordset
With rs 'refer to the RS with "." dots instead of the full name "rs."
If Not .EOF Then .MoveFirst 'move to the first record
Do While Not .EOF 'keep doing this until the end of the recordset
Debug.Print !myField1, !myField2 'do "something" here with the data.
.MoveNext 'move to the next record
Loop 'loop will end if there's no "next record"
.Close 'close the recordset
End With
Set rs = Nothing 'clear the variable
End Sub
A rough adaptation using your example:
Sub recordsetDemo()
Dim data As Recordset
Set data = CurrentDb.OpenRecordset("YourTableOrQueryName") 'open recordset
'***however you setup your "Data" recordset could replace the above code***
With data
If .EOF Then 'check if there's data
MsgBox "No Data Found!"
Exit Sub
End If
.MoveFirst 'move to the first record
Do While Not .EOF 'keep doing this until the end of the recordset
If first Then
first = False
strSig = Replace(strSig, id, !id & id)
Else
strSig = Replace(strSig, id, ", " & !id & id)
End If
.MoveNext 'move to the next record
Loop 'loop will end if there's no "next record"
.Close 'close the recordset
End With
Set rs = Nothing 'clear the variable
End Sub
That's all I can do given the information you provided.
I have a VBA script and I need to create forms based on distinct LocationIDs in a table. So for every row with LocationID = 1 create a form with the name of that location represented in the title of the form, "formLocation1". Then for each LocationID = 2, create another form with the name of that one in the title, "formLocation2", etc. What is the best way to do this using DoCmd.OpenForm"" in the VBA script?
You can try something like this.
Loop through a recordset, and create a form for each LocationID using the CreateForm() method. You can then set the Form's .Caption property to "formLocation(LocationID)".
(Change T to the name of your table).
Public Sub CreateForms()
On Error GoTo ex
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT DISTINCT LocationID FROM T ORDER BY LocationID;", dbOpenSnapshot)
With rs
If .EOF Then GoTo out
.MoveLast
.MoveFirst
End With
Dim frm As Access.Form, i As Integer
For i = 1 To rs.RecordCount
Set frm = CreateForm()
frm.Caption = "formLocation" & rs![LocationID]
DoCmd.Close acForm, frm.Name, acSaveYes
Set frm = Nothing
rs.MoveNext
Next i
out:
On Error Resume Next
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ex:
MsgBox Err.Description, vbCritical
Resume out
End Sub
I am trying to delimit a memo field. The field has within it multiple notes that I need to parse out into different columns. Each note however follows the same logic, starts with mm/dd/yyyy then the note itself followed by a space.
So an example for one memo field would be
01/25/2000 worked on Rack-ID 03/03/2010 contracted Rack-ID 05/15/2014 updated Rack-ID
I need each note parsed out into a different column in Access.
I was working on the Split function in VBA, they had originally had "|" as a delimiter but removed it, now I have to pull on the dates
Note "tbl_example" is the table in my test access database
"Tx_example" is the name of the column holding the data to be delimited in my test access database
Sub Example()
On Error GoTo err_Handler
Dim rsD As DAO.Recordset
Set rsD = CurrentDb.OpenRecordset("tbl_Example")
Do While Not rsD.EOF
rsD.Edit
rsD!F1 = Trim(Split(rsD!Tx_Example, "|")(0))
rsD!F2 = Trim(Split(rsD!Tx_Example, "|")(1))
rsD!F3 = Trim(Split(rsD!Tx_Example, "|")(2))
rsD.Update
rsD.MoveNext
Loop
sub_Exit:
rsD.Close
Set rsD = Nothing
Exit Sub
err_Handler:
If Err.Number = 9 Then
Resume Next
Else
MsgBox "Err: " & Err.Number & vbNewLine & Err.Description
End If
End Sub
Not certain how I replace the "|" with a date search.
Also I'm not against doing a replace and inserting "|" right before each date so I would have my delimiter back.
Problem is I'm not sure how to find the date in a text memo field, otherwise I would be able to use the replace function, or an update query.
Any help is appreciated, thanks.
Public Function AddPipesBeforeDates(ByVal strText As String) As String
Dim regex As RegExp
Dim matches As Object
Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
regex.Pattern = "\d{2}/\d{2}/\d{4}"
Set matches = regex.Execute(strText)
For Each m In matches
strText = Replace(strText, m, "|" & m)
Next
AddPipesBeforeDates = strText
Set matches = Nothing
Set regex = Nothing
End Function
Sub Example()
On Error GoTo err_Handler
Dim rsD As DAO.Recordset
Dim results as variant
Set rsD = CurrentDb.OpenRecordset("tbl_Example")
Do While Not rsD.EOF
results = split(AddPipesBeforeDates(rsD!Tx_Example), "|")
rsD.Edit
rsD!F1 = Trim(results(1))
rsD!F2 = Trim(results(2))
rsD!F3 = Trim(results(3))
rsD.Update
rsD.MoveNext
Loop
sub_Exit:
rsD.Close
Set rsD = Nothing
Exit Sub
err_Handler:
If Err.Number = 9 Then
Resume Next
Else
MsgBox "Err: " & Err.Number & vbNewLine & Err.Description
End If
End Sub
I wrote something like this recently to pull dated notes out of a memo field. This code may not work exactly as is, but will get you closer and give you some ideas.
Some initial notes: Don't expect the routine to do the full job on the first sweep. Create a temp table to write your results to, and each time you run the routine, clear the temp table first. After each run, tweak your code to catch everything it missed in the previous run. This way, you will refine the routine until you capture all your data accurately. You may also have to hand edit some notes to get them to work
+----------+------------+
| Field | DataType |
+----------+------------+
| NoteId | AutoNumber |
| ParentId | Long |
| NoteDate | Date/Time |
| NoteNext | Memo |
+----------+------------+
Also, I highly recommend not using multiple note fields in the same table. Your Notes table should look like my temp_Notes table above. After your routine is successful, its a simple matter of running against your Notes table rather than temp_Notes.
Public Sub MigrateNotes()
Dim db As DAO.Database
Dim rsDest As DAO.Recordset
Dim rsSource As DAO.Recordset
Dim nId As Long
Dim aNotes() As String
Dim n As Long
Dim dtDate As Date
Dim sNote As String
On Error GoTo EH
DoCmd.Hourglass True
Set db = CurrentDb
db.Execute "DELETE * FROM temp_Notes"
Set rsDest = db.OpenRecordset("SELECT * FROM temp_Notes")
Set rsSource = db.OpenRecordset("SELECT RowId,Diary FROM SourceNotes")
With rsSource
Do Until .EOF
nId = .Fields("RowId").Value
aNotes = parseNotes(.Fields("Diary").Value)
For n = 0 To UBound(aNotes)
dtDate = CDate(Left(aNotes(n), 10))
sNote = Right(aNotes(n), Len(aNotes(n)) - 11)
With rsDest
.AddNew
.Fields("RowId").Value = nId
.Fields("NoteDate").Value = dtDate
.Fields("NoteText").Value = sNote
.Update
End With
Next 'n
.MoveNext
Loop
End With
MsgBox "Complete"
GoTo FINISH
EH:
With Err
MsgBox .Number & vbCrLf & .Source & vbCrLf & .Description
.Clear
End With
'for debugging purposes
Debug.Assert 0
GoTo FINISH
Resume
FINISH:
DoCmd.Hourglass False
On Error Resume Next
'release resources
If Not rsDest Is Nothing Then
rsDest.Close
Set rsDest = Nothing
End If
If Not rsSource Is Nothing Then
rsSource.Close
Set rsSource = Nothing
End If
End Sub
Private Function parseNotes(ByVal sRaw As String) As String()
Dim nYear As Long
Dim sYearToken As String
Dim nIndex As Long
Dim nSkip As Long
For nYear = 1999 To Year(Date)
sYearToken = "/" & nYear & " "
'use 12 to skip past first date ("mm/dd/yyyy " = 11)
nSkip = 12
Do
'find the end of the date
nIndex = InStr(nSkip, sRaw, sYearToken)
If nIndex > 0 Then
'find the start of the date
nIndex = nIndex - 6
sRaw = Left(sRaw, nIndex) & vbCrLf & Right(sRaw, Len(sRaw) - nIndex)
'use 12 to skip past next date
nSkip = nIndex + 12
End If
Loop Until nIndex <= 0
Next 'n
parseNotes = Split(sRaw, vbCrLf)
End Function