Slow Form on Access connecting to VPS to load 2 Comboboxes - mysql

As the title says I have a form in access that I use for data entry. This form has to load 2 comboboxes one for suplier name the other for location name. The other thing it does is check if user has access to the form. This is on the load event.
Private Sub Form_Load()
'Verify User Access
If Globales.Accesos(Me.Name) = 0 Then
MsgBox "No tiene accesos a esta area."
DoCmd.Close acForm, Me.Name
End If
'Set Null Values
Me.Text14 = Null
Me.Text16 = Null
Me.Text18 = Null
Me.Combo26 = Null
Me.Text73 = Null
Me.Text28 = Null
Me.Text50 = Null
Me.Text42 = Null
Me.Text46 = Null
Me.Text44 = Null
Me.Text40 = Null
Me.Text48 = Null
Me.Text30 = Null
Me.Text36 = Null
Me.Text38 = Null
Me.Text52 = Null
Me.Text54 = Null
Me.Text75 = Null
'Set Combobox Localidades Values
Dim db2 As DAO.Database
Dim rs2 As DAO.Recordset
Dim SQL2 As String
Set db2 = OpenDatabase("", False, False, Globales.ConnString)
SQL2 = "SELECT tbl5localidades.ID, tbl5localidades.NombreLocalidad FROM tbl5localidades;"
Set rs2 = db2.OpenRecordset(SQL2, dbOpenDynaset, dbReadOnly)
With Text18
.RowSourceType = "Value List"
.BoundColumn = 1
.ColumnCount = 2
.ColumnWidths = "0;1in"
End With
With rs2
.MoveFirst
Do Until .EOF
Text18.AddItem !ID & ";" & !NombreLocalidad
.MoveNext
Loop
End With
rs2.Close
Set rs2 = Nothing
'db2.Close
'Set db2 = Nothing
'Set Combobox Suplidores Values
Dim db3 As DAO.Database
Dim rs3 As DAO.Recordset
Dim SQL3 As String
Set db3 = OpenDatabase("", False, False, Globales.ConnString)
SQL3 = "SELECT tbl6suplidores.ID, tbl6suplidores.NombreSuplidor FROM tbl6suplidores ORDER BY tbl6suplidores.NombreSuplidor;"
Set rs3 = db3.OpenRecordset(SQL3, dbOpenDynaset, dbReadOnly)
With Combo26
.RowSourceType = "Value List"
.BoundColumn = 1
.ColumnCount = 2
.ColumnWidths = "0;1in"
End With
With rs3
.MoveFirst
Do Until .EOF
Combo26.AddItem !ID & ";" & !NombreSuplidor
.MoveNext
Loop
End With
rs3.Close
Set rs3 = Nothing
'db3.Close
'Set db3 = Nothing
End Sub
This works as intended but its so slow that get Acces to be unresponsive for about 30sec. Is there anyway to optimize this to load faster?

Well, a “value” list driving a combo box is good for about 100, maybe 200 rows.
After that?
Don’t use a value list. Just shove the sql right into the combo/listbox data source.
Eg:
Me.Text18.Rowsource = "SELECT tbl5localidades.ID, tbl5localidades.NombreLocalidad FROM tbl5localidades;"
In fact, since the sql is not dynamic, then just place the sql right into the row source, and you don’t need any code at all.
You not mentioned how large this table is that drives the combo box, but Access will try and do its best to only pull the on row PK from that list until you open the combo box. So, don’t use “value/list”, but use sql for the combo box. You could also declare the record set at the forms level, and shove that into the combo box on form load as a data source, but using just the sql you have and no code likely will work the best.
A value list also has a hard limit of about 4000 characters, and thus that is another wall you can hit rather easy.
Do NOT use a pass-through query for this – the client cannot optimize the PT query, so a plane Jane linked table, and a plane Jane sql should work just fine.
And, of course change the combo box setting from value list to table/query

Related

VBA Do While Loop

Good Morning,
I am building a database that will be used for scheduling employee work assignments. Below is the code that I am using to create the actual daily work assignments. The intent is that this will loop through each employee in the company and if they are in a work status it will also read their assigned schedule version. Then if the employee is in a work status the db will list their work assignments for each day.
The issue that I am encountering is that this only reads the first employee in the table and gives every other employee the work assignments that the first employee should have. Again, the intent is that the code will look at each employees, one at a time, and append the correct assignments to tbl_employee_work_assignments based on each employees status and schedule version.
Can someone help me understand how to do this correctly, please?
Many Thanks!!!
Private Sub btn_build_assignment_schedule_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl_employees")
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tbl_employee_work_assignments"
Do While Not rs.EOF
Dim X As String
Dim Y As String
X = employee_schedule_version.Value
Y = employee_status.Value
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tbl_employee_work_assignments"
Select Case True
Case X = 1 And Y = 1
db.Execute "qry_append_schedule_1"
Case X = 2 And Y = 1
db.Execute "qry_append_schedule_2"
Case X = 3 And Y = 1
db.Execute "qry_append_schedule_3"
Case X = 4 And Y = 1
db.Execute "qry_append_schedule_4"
End Select
rs.MoveNext
Loop
rs.Close
End Sub
Based on the very limited information provided and making a few assumptions, I would hazard a guess that your code should be changed to something along the lines of the following:
Private Sub btn_build_assignment_schedule_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl_employees")
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE FROM tbl_employee_work_assignments"
With rs
Do Until .EOF
If !employee_status = "1" Then
Select Case !employee_schedule_version
Case "1": db.Execute "qry_append_schedule_1"
Case "2": db.Execute "qry_append_schedule_2"
Case "3": db.Execute "qry_append_schedule_3"
Case "4": db.Execute "qry_append_schedule_4"
End Select
End If
.MoveNext
Loop
.Close
End With
End Sub
This assumes that employee_status and employee_schedule_version are string-valued fields in your table tbl_employees.
Without knowing the structure of your table tbl_employees and the SQL behind your queries qry_append_schedule_1, qry_append_schedule_2, etc. it is difficult to advise.

Access VBA export one row of table to excel spreadsheet, not entire table

I'm attempting to write a loop in VBA for Access 2010, where the loop looks through a table (table: "SunstarAccountsInWebir_SarahTest") and evaluates a number of conditions, and depending on the condition - may then loop through a different table ("1042s_FinalOutput_7") to see if it has an ID that matches. If it does match, it inserts "Test" into a field, if not - it should export that row of values (from the first loop - out of "SunstarAccountsInWebir_SarahTest") into an excel file.
My issue is that my code is exporting the entirety of the table "SunstarAccountsInWebir_SarahTest", I only want it to export the row corresponding to the value of i in the loop. How can I amend my code to do this?
Public Sub EditFinalOutput2()
'set loop variables
Dim i As Long
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim strSQL As String
Dim external_nmad_id As String
Dim IRSfileFormatKey As String
'Function GetID(external_nmad_id As String, IRSfileFormatKey As String)
'open reference set
Set db = CurrentDb
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest")
Set ss = db.OpenRecordset("1042s_FinalOutput_7")
'set loop for whole recordset(this is the original location, will try putting it within the If, ElseIf loop)
'For i = 0 To qs.RecordCount - 1
With qs.Fields
For i = 0 To qs.RecordCount - 1
If (IsNull(!nmad_address_1) Or (!nmad_address_1 = !nmad_city) Or (!nmad_address_1 = !Webir_Country) And IsNull(!nmad_address_2) Or (!nmad_address_2 = !nmad_city) Or (!nmad_address_2 = !Webir_Country) And IsNull(!nmad_address_3) Or (!nmad_address_3 = !nmad_city) Or (!nmad_address_3 = !Webir_Country)) Then
MsgBox "This was an invalid address"
Else:
With ss.Fields
For j = 0 To ss.RecordCount - 1
If (qs.Fields("external_nmad_id") = Right(ss.Fields("IRSfileFormatKey"), 10)) Then
ss.Edit
ss.Fields("box13_Address") = "Test"
ss.Update
Else: DoCmd.TransferSpreadsheet acExport, 10, "SunstarAccountsInWebir_SarahTest", "\\DTCHYB-MNMH001\C_WBGCTS_Users\U658984\My Documents\pre processor\PreProcessor7\ToBeReviewed\AddressesNotActiveThisYear.xlsx", False
End If
ss.MoveNext
Next j
End With
End If
qs.MoveNext
Next i
End With
'close reference set
qs.Close
Set qs = Nothing
ss.Close
Set ss = Nothing
End Sub
This ended up being the closest. I needed to switch to a "Do While" loop rather than a second integer loop. The code for so is below:Public Sub EditFinalOutput2()
'set variables
Dim i As Long
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim strSQL As String
Dim external_nmad_id As String
Dim IRSfileFormatKey As String
Dim mytestwrite As String
mytestwrite = "No"
'open reference set
Set db = CurrentDb
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest")
Set ss = db.OpenRecordset("1042s_FinalOutput_7")
With qs.Fields
For i = 0 To qs.RecordCount - 1
If (IsNull(!nmad_address_1) Or (!nmad_address_1 = !nmad_city) Or
(!nmad_address_1 = !Webir_Country) And IsNull(!nmad_address_2) Or (!nmad_address_2 =
!nmad_city) Or (!nmad_address_2 = !Webir_Country) And IsNull(!nmad_address_3) Or
(!nmad_address_3 = !nmad_city) Or (!nmad_address_3 = !Webir_Country)) Then
DoCmd.RunSQL "INSERT INTO Addresses_ToBeReviewed SELECT
SunstarAccountsInWebir_SarahTest.* FROM SunstarAccountsInWebir_SarahTest WHERE
(((SunstarAccountsInWebir_SarahTest.external_nmad_id)='" & qs!external_nmad_id &
"'));"
Else:
Set ss = db.OpenRecordset("1042s_FinalOutput_7")
With ss.Fields
'if not invalid address, loop through second (final output) table to find
matching ID's
If ss.EOF = False Then
ss.MoveFirst
Do
Dim mykey As String
mykey = Right(ss!IRSfileFormatKey, 10)
Debug.Print mykey
If qs.Fields("external_nmad_id") = mykey Then
ss.Edit
ss.Fields("box13c_Address") = qs.Fields("nmad_address_1") &
qs.Fields("nmad_address_2") & qs.Fields("nmad_address_3")
ss.Update
mytestwrite = "Yes"
End If
ss.MoveNext
'if the valid address doesn't match to final output table, add to list of
addresses not matched
Loop Until ss.EOF
If mytestwrite = "No" Then
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO Addresses_NotUsed SELECT
SunstarAccountsInWebir_SarahTest.* FROM SunstarAccountsInWebir_SarahTest WHERE
(((SunstarAccountsInWebir_SarahTest.external_nmad_id)='" & qs!external_nmad_id &
"'));"
DoCmd.SetWarnings True
End If
End If
End With
End If
qs.MoveNext
Next i
End With
'close reference set
qs.Close
Set qs = Nothing
ss.Close
Set ss = Nothing
End Sub
Ok, based on your stated goal, there are a few errors in your approach.
Here is how I understand your goal based on your opening paragraph:
Loop through each record in table TableA. If the record meets
certain complex criteria, search a second table TableB to see if any
records in TableB contain a matching ID value from this record in
TableA. If a match exists, update a field in TableB, otherwise, export the record from TableA to Excel.
I will describe how the code you have presented is processing your data, and then I will explain how I would approach this problem.
First, as #ScottHoltzman alluded, the DoCmd.TransferSpreadsheet statement that you have in your code will, of course, transfer the entire table to Excel because that is what you told it to do. The 3rd parameter specifies the data to be exported, and you gave it the full table name, so the full table will be exported.
Second, I think you are misunderstanding how looping through the two RecordSets in your code is actually functioning. Your code is doing the following:
Evaluate a record in qs. If it doesn't meet the criteria, move to the next qs record and repeat step 1.
If the record in qs does meet the criteria, evaluate a record in ss against this record in qs.
If they match, update ss and move to the next ss record, go to step 2, remembering that qs is still pointing at the same record and has not moved.
If they do not match, transfer the entire table to Excel, now move to the next ss record, go to step 2, again remembering that qs is still pointing at the same record and has not moved.
Once all records in ss have been processed through steps 2, 3 & 4, move to the next qs record and go to step 1
I would expect your code to export the table to Excel over and over again many times.
I would also expect your code to get an error as soon as you begin to process the 2nd qs record that moves on to step 2 because after having processed steps 2, 3 & 4 for the first qs record that met your criteria, the ss RecordSet will be pointing at EOF, and you don't have any code to move the pointer back to the first record in ss.
Anyway, since you have a complex criteria for determining if a record is exported or not, I would recommend adding a single True/False field to TableA called ToExport. Now, at the beginning of your code, you would set ToExport = False for all records in TableA. Then, your code would work to evaluate each record in TableA to determine if the record should be exported. If it should, you update ToExport to be True. Once you have looped through the entire table, only the records needing exported will be marked as ToExport = True. Now, you export just the True records to Excel, thereby achieving your desired result.
Here is some code that should achieve this goal in an efficient manner. This code tries to use the tables and criteria from your original source. It also replaces your With blocks and For loops with more useful Do loops, taking advantage of built-in RecordSet looping and EOF checking.
Public Sub EditFinalOutput2()
Dim db As DAO.Database
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb()
strSQL = "UPDATE [SunstarAccountsInWebir_SarahTest] SET ToExport = False;"
db.Execute strSQL
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest", dbOpenDynaset)
Do While Not qs.EOF
If (IsNull(qs("nmad_address_1")) Or (qs("nmad_address_1") = qs("nmad_city")) Or (qs("nmad_address_1") = qs("Webir_Country")) And IsNull(qs("nmad_address_2")) Or (qs("nmad_address_2") = qs("nmad_city")) Or (qs("nmad_address_2") = qs("Webir_Country")) And IsNull(qs("nmad_address_3")) Or (qs("nmad_address_3") = qs("nmad_city")) Or (qs("nmad_address_3") = qs("Webir_Country"))) Then
MsgBox "This was an invalid address"
Else
strSQL = "SELECT * FROM [1042s_FinalOutput_7] WHERE Right([IRSfileFormatKey], 10) = """ & qs("external_nmad_id") & """;"
Set ss = db.OpenRecordset(strSQL, dbOpenDynaset)
If ss.BOF Then
qs.Edit
qs("ToExport") = True
qs.Update
Else
Do While Not ss.EOF
ss.Edit
ss("box13_Address") = "Test"
ss.Update
ss.MoveNext
Loop
End If
ss.Close
End If
qs.MoveNext
Loop
qs.Close
strSQL = "SELECT * FROM [SunstarAccountsInWebir_SarahTest] WHERE ToExport = True;"
DoCmd.TransferSpreadsheet acExport, 10, strSQL, "\\DTCHYB-MNMH001\C_WBGCTS_Users\U658984\My Documents\pre processor\PreProcessor7\ToBeReviewed\AddressesNotActiveThisYear.xlsx", False
Set qs = Nothing
Set ss = Nothing
db.Close
Set db = Nothing
End Sub
I hope this helps you better achieve your goal.
Create a query like this, and execute it, and return dim rst as Recordset
NOTE: I have changed the AND-s to OR-s as that is what I think you want...
Select qs.*
From
(Select *
From SunstarAccountsInWebir_SarahTest
Where Not
(
(IsNull(nmad_address_1)
Or (nmad_address_1 = nmad_city)
Or (nmad_address_1 = Webir_Country)
OR IsNull(nmad_address_2)
Or (nmad_address_2 = nmad_city)
Or (nmad_address_2 = Webir_Country)
OR IsNull(nmad_address_3)
Or (nmad_address_3 = nmad_city)
Or (nmad_address_3 = Webir_Country)
)
) as qs
Left Join
(Select *
,Right(ss.Fields("IRSfileFormatKey"), 10) as ssKey
From 1042s_FinalOutput_7
) as ss
On qs.external_nmad_id = ss.ssKey
Where ssKey is NULL
Then output the rst --(taken from https://support.microsoft.com/en-us/help/246335/how-to-transfer-data-from-an-ado-recordset-to-excel-with-automation )
' Copy field names to the first row of the worksheet
fldCount = rst.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
Next
' Copy the recordset to the worksheet, starting in cell A2
xlWs.Cells(2, 1).CopyFromRecordset rst
'Note: CopyFromRecordset will fail if the recordset
'contains an OLE object field or array data such
'as hierarchical recordsets

Audit Tracking but wont save

I am using the below code to track changes on a form and it works fine.
However, I am trying to use it on my main form to record just the date/time that someone clicks a button However I get the following error:
You entered an expression that has no value
The debug takes me to this:
rs!PriorInfo = Screen.ActiveControl.OldValue
My code
Function TrackChanges()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strCtl As String
Dim strReason As String
' strReason = InputBox("Reason For Changes")
strCtl = Screen.ActiveControl.Name
strSQL = "SELECT Audit.* FROM Audit;"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
If rs.RecordCount > 0 Then rs.MoveLast
With rs
.AddNew
rs!FormName = Screen.ActiveForm
rs!ControlName = strCtl
rs!DateChanged = Date
rs!TimeChanged = Time()
rs!PriorInfo = Screen.ActiveControl.OldValue
rs!NewInfo = Screen.ActiveControl.Value
rs!CurrentUser = fOSUserName
' rs!Reason = strReason
.Update
End With
Set db = Nothing
Set rs = Nothing
End Function
I assume I need to tell it to accept null values but unsure how?
Nz(Screen.ActiveControl.OldValue) will return an empty string instead of a null value.
Nz(Screen.ActiveControl.OldValue,"<Null>") if PriorInfo is text and you want to record it was null.
Nz(Screen.ActiveControl.OldValue,-1) if PriorInfo is numeric and -1 is a safe "null" number.

How can one find and delete a record in a DAO Recordset where two record values are equal to two separate combo boxes on a form

I have an ACCESS 2010 Form:
The Activity Roster table looks like this:
I would like to remove a member from a given activity and have developed some code that I think is close, but cannot resolve a critical issue. I have to find the row in the Activity Roster table that has a record with the ActivityID and MemberID values that correspond to the “Activity Name” combo box and “Remove Member” combo box. Here is the code:
Private Sub cmdRemoveMember_Click()
Dim MembeID As Long, CutMemID As Long, ActID As Long
Dim db As DAO.Database, rsIn As DAO.Recordset, rsOut As DAO.Recordset
Set db = CurrentDb
Dim strQName As String
CutMemID = Me!cboCutMember.Column(0) 'set the value of CutMemID as the MemberID from the Remove Member combo box
ActID = Me.cboActivityName.Column(0) 'store the ActID from the Activity Name combo box
'query the tblActivityRoster for records with specified Activity ID (Name)- this generates the QActivityMembership query
strQName = "SELECT * FROM [tblActivityRoster] WHERE [ActivityID] = " & ActID
Set rsIn = db.OpenRecordset(strQName, dbOpenDynaset, dbReadOnly)
rsIn.MoveLast 'this will "populate the recordset"
'prepare to remove a member from the tblActivityRoster
Set rsOut = db.OpenRecordset("tblActivityRoster", dbOpenDynaset, dbEditAdd)
rsOut.MoveLast 'this will "populate the recordset"
With rsOut 'from the tblActivityRoster, find the record where the Activity ID = ActID and MemberID = CutMemID
Do Until rsOut.EOF
If rsOut![ActivityID] = ActID And rsOut![MemberID] = CutMemID Then 'THIS IS WHERE IF FAILS!!
rsOut.Delete
End If
rsOut.MoveNext
Loop
End With
Me.QActivityMembership_subform.Form.Requery
'Now close the query
DoCmd.Close acQuery, strQName
'now clear everything
rsIn.Close
rsOut.Close
Set rsIn = Nothing
Set rsOut = Nothing
Set db = Nothing
End Sub
Would appreciate any help…thank you!
Micheal,
Your code looks like it is taking the long way around. Why not just use a DELETE query? Sample:
Private Sub cmdRemoveMember_Click()
Dim CutMemID As Long, ActID As Long, strQName As String
Dim db As DAO.Database
Set db = CurrentDb
CutMemID = Me!cboCutMember.Column(0) 'set the value of CutMemID as the MemberID from the Remove Member combo box
ActID = Me.cboActivityName.Column(0) 'store the ActID from the Activity Name combo box
' build delete query for Activity and Member
strQName = "DELETE FROM [tblActivityRoster] WHERE ([ActivityID] = " & ActID & ") AND ([MemberID] = " & CutMemID & ");"
' delete all matching records
db.Execute strQName, dbSeeChanges + dbFailOnError
Me.QActivityMembership_subform.Form.Requery
Set db = Nothing
End Sub
Much more straightforward.

How to search a field in a table in Access

Using VBA, how can I search for a text string, for example "CHIR", in a table called "ServiceYES", in the field "Service".
After that, I would like to save the neighboring field for all the rows that "CHIR" exists in the table "ServicesYES". The "ServiceYES" table is below:
I basically, want to find all the "CHIR" in "Service" column and then save the names which are on the left of the CHIR, eg "FRANKL_L", "SANTIA_D" as an array.
Thanks for all your help in advance.
Start by creating a SELECT query.
SELECT Code_Perso
FROM ServicesYES
WHERE Service = 'CHIR';
Use SELECT DISTINCT Code_Perso if you want only the unique values.
Add ORDER BY Code_Perso if you care to have them sorted alphabetically.
Once you have a satisfactory query, open a DAO recordset based on that query, and loop through the Code_Perso values it returns.
You don't need to load them directly into your final array. It might be easier to add them to a comma-separated string. Afterward you can use the Split() function (assuming you have Access version >= 2000) to create your array.
Here's sample code to get you started. It's mostly standard boiler-plate, but it might actually work ... once you give it "yourquery".
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strItems As String
Dim varItems As Variant
Set db = CurrentDb
Set rs = db.OpenRecordset("yourquery", dbOpenSnapshot)
With rs
Do While Not .EOF
strItems = strItems & "," & !Code_Perso
.MoveNext
Loop
.Close
End With
If Len(strItems) > 0 Then
' discard leading comma '
strItems = Mid(strItems, 2)
varItems = Split(strItems, ",")
Else
MsgBox "Oops. No matching rows found."
End If
Set rs = Nothing
Set db = Nothing
I tested this and it seems to work. This function will pull all records where ServiceYes='CHIR' and dump the Code_Person value into an array which it will return:
Function x() As String()
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset( _
"Select * from ServiceYES where Service='CHIR'")
Dim Arr() As String
Dim i As Integer
While rst.EOF = False
ReDim Preserve Arr(i)
Arr(i) = rst.Fields("Code_Person")
i = i + 1
rst.MoveNext
Wend
x = Arr
End Function
Sample Usage:
Debug.Print x()(0)
Paolo,
Here is something I threw together in a few minutes. You can add it to the VBA editor in a module. It uses a trick to get the RecordCount property to behave properly. As for returing the array, you can update the function and create a calling routine. If you need that bit of code, just post a comment.
Thanks!
Option Compare Database
Function QueryServiceYES()
Dim db As Database
Dim saveItems() As String
Set db = CurrentDb
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("SELECT Code_Perso, Service, Favorites " & _
"FROM ServiceYES " & _
"WHERE Service = 'CHIR'")
'bug in recordset, MoveFirst, then MoveLast forces correct invalid "RecordCount"
rs.MoveLast
rs.MoveFirst
ReDim Preserve saveItems(rs.RecordCount) As String
For i = 0 To rs.RecordCount - 1
saveItems(i) = rs.Fields("Code_Perso")
rs.MoveNext
Next i
'print them out
For i = 0 To UBound(saveItems) - 1
Debug.Print saveItems(i)
Next i
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Function