Recordset Not Iterating - ms-access

I am sure this is strictly user error, but for the life of me, I can not discover how to iterate a table, and write the records to Excel. I have the below code, but it hangs on the first Manager ID and just repeats the write for that one constantly in a loop. I want to iterate all the Manager ID in the table and write them to the same workbook.
How should I tweak this code in order to do such?
Set xlR = xlWb.Worksheets(1).Range("$R$2")
i=0
Set rs2 = Db.OpenRecordset("SELECT * FROM TestTable ORDER BY [Manager ID] ASC", dbOpenDynaset)
managerName = CLng(rs2.Fields(3).Value)
Debug.Print managerName
With rs2
.MoveLast
.MoveFirst
Do While Not .EOF
xlR.Value = .Fields(0).Value
xlR.Offset(ColumnOffset:=1 + (i * 2)).Value = .Fields(2).Value
xlR.Offset(ColumnOffset:=2 + (i * 2)).Value = "ENTATH01"
i = i + 1
.MoveNext
Loop
.Close
End With
xlWb.SaveAs FileName:=sPath & sFile, FileFormat:=xlOpenXMLWorkbook
xlWb.Close SaveChanges:=True
rs2.MoveNext

You're not changing your offset, so you're continuously assigning the same cell.
Try the following:
xlR.Offset(ColumnOffset:=i * 3).Value
xlR.Offset(ColumnOffset:=1+(i*3)).Value = .Fields(2).Value
xlR.Offset(ColumnOffset:=2+(i*3)).Value = "ENTATH01"
I assume you're initializing i to 0

Change:¨
i = i + 1
.MoveNext
to
i = i + 2
.MoveNext

Related

Serial with conditions starting from variable number ms-access

Guys i have this function which some of you helped me with. I tried to add one condition and i couldn’t
My Function:
Sub MakeNum2()
Dim rs As DAO.Recordset, intS As Integer, strG As String
Set rs = CurrentDb.OpenRecordset("SELECT [Warehouse] & [TransType] AS Grp, TblImportTemp.zdate, TblImportTemp.Doc From TblImportTemp ORDER BY [Warehouse] & [TransType], TblImportTemp.zdate;")
strG = rs!grp
While Not rs.EOF
If strG = rs!grp Then
intS = intS + 1
rs.Edit
rs!Doc = intS
rs.Update
rs.MoveNext
Else
intS = 0
strG = rs!grp
End If
Wend
End Sub
I don’t need it to start the serializing from Number 1 So The Condition i need to add is to get the last Doc Number From QryLastDoc where Grp (In My Function) = Grp2 In QryLastDoc And Set this number as the beginning of Serial then proceed to add 1 for each new doc as usual.
QryLastDoc
SELECT QryTransTopDoc.Warehouse, QryTransTopDoc.Type, Last(QryTransTopDoc.Doc) AS LastOfDoc, [Warehouse] & [Type] AS Grp2
FROM QryTransTopDoc
GROUP BY QryTransTopDoc.Warehouse, QryTransTopDoc.Type, [Warehouse] & [Type];
The Result: the first record will be the last doc number from QryLastDoc +1 then the following will be doc+1 Thanks in Advance
EDIT #1 : It couldn’t be done by Dlookup Guys
`intS = Nz(DLookup("Doc", "QryTransTopDoc", "Grp2='" & rs!Grp & "'"), 0)`
Dlookup Result will be the ground number for serializing meaning the first record DOC will be Dlookup+1 then the following records will be DOC+1 I wish i could explain more . Thanks again
Could use DLookup() domain aggregate function to pull last value generated to set variable with initial value outside loop. Then increment the variable within loop.
Dim rs As DAO.Recordset, intS As Integer, strG As String
Set rs = CurrentDb.OpenRecordset("SELECT [Warehouse] & [TransType] AS Grp, TblImportTemp.zdate, TblImportTemp.Doc From TblImportTemp ORDER BY [Warehouse] & [TransType], TblImportTemp.zdate;")
intS = Nz(DLookup("Doc", "QryTransTopDoc", "Grp2='" & rs!Grp & "'"), 0)
strG = rs!grp
While Not rs.EOF
If strG = rs!grp Then
intS = intS + 1
rs.Edit
rs!Doc = intS
rs.Update
rs.MoveNext
Else
intS = Nz(DLookup("Doc", "QryTransTopDoc", "Grp2='" & rs!Grp & "'"), 0)
strG = rs!grp
End If
Wend
Or use DMax() on table.
Alternatively, don't save this value to table and instead calculate when needed. MS Access Restart Number Sequence

(VB6) Run-time error ‘-2147217864(80040e38)’: Row cannot be located for updating. Some values may have been changed since it was last read

i have a process that will update the records of the material. but first it will get the existing records of the material like avail quantity before updating and when i try to update it with the new one. i get an error saying "Run-time error ‘-2147217864(80040e38)’: Row cannot be located for updating. Some values may have been changed since it was last read."
Dim rs As New ADODB.Recordset
Set rs = New ADODB.Recordset
Dim coy As String
If Left(Text4.Text, 3) = "800" Then
For i = 1 To ListView2.ListItems.Count
With ListView2.ListItems(i)
If rs.State <> 0 Then rs.Close
rs.Open "Select * from Inventory where InventoryID = " & Val(.ListSubItems(6).Text), db, 3, 3
If rs.RecordCount <> 0 Then
'get average cost start
Dim avgcost, Stockqty, newstockqty As Double
Stockqty = CDbl(rs!AvailQty) * CDbl(rs!unitprice)
newstockqty = CDbl(.ListSubItems(7).Text) * CDbl(.ListSubItems(8).Text)
avgcost = (Stockqty + newstockqty) / CDbl(CDbl(rs!AvailQty) +
CDbl(.ListSubItems(7).Text))
'get average cost end
rs!avecost = FormatNumber(avgcost, 3)
avaiqtyparam = CDbl(rs!AvailQty) + CDbl(.ListSubItems(7).Text)
rs!AvailQty = CDbl(rs!AvailQty) + CDbl(.ListSubItems(7).Text)
rs!unitprice = FormatNumber(CDbl(.ListSubItems(8).Text), 5)
rs!lastupdate = FormatDateTime(DTPicker1.Value, vbShortDate)
Dim AvgVat, stockvat, nestockvat As Double
stockvat = CDbl(rs!AvailQty) * CDbl(rs!AvailVAT)
nestockvat = CDbl(.ListSubItems(7).Text) * CDbl(.ListSubItems(11).Text)
AvgVat = (stockvat + nestockvat) / CDbl(CDbl(rs!AvailQty) +
CDbl(.ListSubItems(11).Text))
rs!AvailVAT = CDbl(.ListSubItems(11).Text)
rs!AveVAT = FormatNumber(AvgVat, 3)
rs.Update
End If
End With
rs.Close
Set rs = Nothing
Next i

MS ACCESS: I need to add a suffix to duplicate values on my table

I want to add suffix to all duplicate fields on my table.
Ex.
Table 1
abcde
abcde
abcde
fghij
fghij
klmno
Expected Result
Table 1
abcde(1)
abcde(2)
abcde(3)
fghij(1)
fghij(2)
klmno
Any idea how I can accomplish this task using MS ACCESS???
Thank you.
First select the duplicates, rather than looping though the entire table. Then append a suffix to the duplicates.
...you need to add a ID/AutoNumber field to your table so that each individual duplicate can be targeted.
Dim dbs As Database
Dim rstDuplicates As Recordset
Dim rst As Recordset
Dim n As Integer
Set dbs = CurrentDb
Set rstDuplicates = dbs.OpenRecordset("SELECT tblRenameDuplicates.f_FieldName FROM tblRenameDuplicates GROUP BY tblRenameDuplicates.f_FieldName HAVING Count(f_FieldName)>1;")
rstDuplicates.MoveLast
rstDuplicates.MoveFirst
If Not rstDuplicates.EOF Then
Do While Not rstDuplicates.EOF
Set rst = dbs.OpenRecordset("SELECT * FROM tblRenameDuplicates WHERE tblRenameDuplicates.f_FieldName = '" & rstDuplicates!f_FieldName & "';")
rst.MoveLast
rst.MoveFirst
n = 1
Do While Not rst.EOF
DoCmd.RunSQL ("UPDATE tblRenameDuplicates SET f_FieldName = '" & rst!f_FieldName.Value & n & "' WHERE f_FieldID = " & rst!f_fieldID & ";")
n = n + 1
rst.MoveNext
Loop
rstDuplicates.MoveNext
Loop
End If
rst.Close
rstDuplicates.Close
Set rst = Nothing
Set rstDuplicates = Nothing
Set dbs = Nothing
OR, if no ID/AutoNumber field can be added to the table:
Do While Not rst.EOF
rst.Edit
rst!f_fieldname = rst!f_fieldname & n
rst.Update
n = n + 1
rst.MoveNext
Loop

MS-Access RecordCount Returns a valid number, but .GetRows only pulls one record

Ok I am trying to dynamically get recordCount and pass that to .GetRows but it doesnt work as it only pulls in one records into the array. If I just statically put a number into the .GetRows method it works fine, but this is obviously not ideal.
This Works
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Client", dbOpenDynaset, dbSeeChanges)
aRR = rs.GetRows("random number")
For i = 0 To rs.RecordCount - 1
For j = 0 To rs.Fields.Count - 1
Debug.Print ; aRR(j, i)
Next j
Next i
This does not
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Client", dbOpenDynaset, dbSeeChanges)
With rs
rs.MoveLast
Debug.Print ; rs.RecordCount
Q = rs.RecordCount
aRR = rs.GetRows(Q)
End With
For i = 0 To rs.RecordCount - 1
For j = 0 To rs.Fields.Count - 1
Debug.Print ; aRR(j, i)
Next j
Next i
I have tried multiple things I have found on the web but clearly I must be missing something? Is there an easy approach to this or do i need to requery with a DISTINCT clase, and pass the return value within that record set to a new variable?
GetRows also uses the recordset's pointer. With rs.MoveLast you put that pointer to the last row. That's why only one row gets returned. Addrs.MoveFirst after setting Q to resolve this.
Like Phesago mentioned, Access will only return the recordcount based on which record in the recordset it's looking at. As a general practice when working with recordsets, I always begin with the following template:
Private Sub CreateRecordset()
Dim rs As Recordset
Dim sql As String
sql = "SELCT * FROM tblSomeTable"
Set rs = CurrentDb.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges)
With rs
If Not .EOF And Not .BOF Then
.MoveLast
.MoveFirst
Dim i As Integer
For i = 0 To rs.RecordCount - 1
'do whatever actions desired
Next
End If
End With
End Sub

Copying data from a MS Access form into Excel

I have code that takes fields from a MS Access form and copies the data into a saved Excel file. The first record in Access in imported to Excel with a range of A2:I2. The second record in Access is imported to Excel with a range of A3:I3, and so on.... What currently happens now is if I close my form in Access and open it back up, and say I already had two records imported into this same Excel file, and now I want to add a third record, it will start over at the first row (A2:I2) and write over what is already there. My question is how can I, if I close and open Access keep it from starting over on (A2:I2), and instead start at the next available row, which to follow the example given would be (A4:I4)? This is the code I have
Private Sub Command73_Click()
Set objXLApp = CreateObject("Excel.Application")
Set objXLBook = objXLApp.Workbooks.Open("Y:\123files\Edmond\Hotel Reservation Daily.xls")
objXLApp.Application.Visible = True
With objXLBook.ActiveSheet
Set r = .usedRange
i = r.Rows.Count + 1
.Cells(i + 1, 1).Value = Me.GuestFirstName & " " & GuestLastName
.Cells(i + 1, 2).Value = Me.PhoneNumber
.Cells(i + 1, 3).Value = Me.cboCheckInDate
.Cells(i + 1, 4).Value = Me.cboCheckOutDate
.Cells(i + 1, 5).Value = Me.GuestNo
.Cells(i + 1, 6).Value = Me.RoomType
.Cells(i + 1, 7).Value = Me.RoomNumber
.Cells(i + 1, 8).Value = Date
.Cells(i + 1, 9).Value = Me.Employee
End With
Set r = Nothing
Set objXLBook = Nothing
Set objXLApp = Nothing
End Sub
You can get the last used row:
Set r = objXLBook.ActiveSheet.UsedRange
i = r.Rows.Count + 1
Some notes.
Private Sub Command73_Click()
''It is always a good idea to put sensible names on command buttons.
''It may not seem like much of a problem today, but it will get there
Dim objXLApp As Object
Dim objXLBook As Object
Dim r As Object
Dim i As Integer
''It is nearly always best to check whether Excel is open before
''opening another copy.
Set objXLApp = CreateObject("Excel.Application")
Set objXLBook = objXLApp.Workbooks.Open( _
"Y:\123files\Edmond\Hotel Reservation Daily.xls")
objXLApp.Application.Visible = True
''It is generally best to specify the sheet
''With objXLBook.ActiveSheet
With objXLBook.Sheets("Room Reservation")
''If the used range includes empty rows
''it may not suit
''Set r = .UsedRange
''i = r.Rows.Count + 1
''From comments, it appears that the data is dense
''but with a number of empty rows at the end of the sheet
i = .Range("A1").End(xlDown).Row + 1
.Cells(i, 1).Value = Me.GuestFirstName & " " & GuestLastName
.Cells(i, 2).Value = Me.PhoneNumber
.Cells(i, 3).Value = Me.cboCheckInDate
.Cells(i, 4).Value = Me.cboCheckOutDate
.Cells(i, 5).Value = Me.GuestNo
.Cells(i, 6).Value = Me.RoomType
.Cells(i, 7).Value = Me.RoomNumber
.Cells(i, 8).Value = Date
.Cells(i, 9).Value = Me.Employee
End With
''Tidy up
Set objXLBook = Nothing
Set objXLApp = Nothing
End Sub
You might also like to look at TransferSpreadsheet.
Another possibility is to use the RecordsetClone, for data from a form, or any recordset, for that matter. It does not give quite the same control, but it is very fast:
Dim objXLApp As Object
Dim objXLBook As Object
Dim r As Object
Dim i As Integer
Dim rs As DAO.Recordset
Set objXLApp = CreateObject("Excel.Application")
objXLApp.Visible = True
Set objXLBook = objXLApp.Workbooks.Open( _
"Y:\123files\Edmond\Hotel Reservation Daily.xls")
Set rs = Me.RecordsetClone
With objXLBook.Sheets("Sheet1")
Set r = .UsedRange
i = r.Rows.Count + 1
.Cells(i, 1).CopyFromRecordset rs
End With