I'm wondering if anyone can help me. I'm trying to populate a public dictionary from a recordset returned from an sql table.
It all seems to work fine, except one part. I don't know if it's not counting the number of keys in the dictionary correctly, or they aren't being entered correctly but for whatever reason when I try and show the total count, it always comes back with only 1 (supposed to be around 15) and only displays the first row details.
Can anyone help?
Public UserList As New scripting.Dictionary
Sub UserDL()
Dim USList As Range
Dim USArr(0 To 11) As Variant
Call ConnecttoDB
Set Cmd = New adodb.Command: Set rs = New adodb.Recordset
With Cmd
.CommandTimeout = 30
.ActiveConnection = cn
.CommandText = "CSLL.DLUsers"
Set rs = .Execute
End With
With rs
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
For i = 1 To 11
USArr(i - 1) = rs(i)
Next i
With UserList
If Not .Exists(rs("Alias")) Then
.Add Key:=rs("Alias"), Item:=USArr
End If
End With
.MoveNext
Wend
End If
End With
IA = UserList.Items
Debug.Print UserList.Count & " Items in the dictionary"
For Each element In IA
For i = 0 To 10
Debug.Print element(i)
Next i
Next element
Set Cmd = Nothing: Set rs = Nothing ': Set UserList = Nothing
End Sub
rs("Alias") is a Field object. The default property for a Field object is Value, so normally just referring to the Field object gives us what we want - the value. However, a Dictionary can store objects (as the value or the key), so when you add an object it actually stores the object rather than the default property. So in your code, you add rs("Alias") as a key, i.e. the object and not the value. When you move to the next record, rs("Alias") is still the same object - only the value has changed. Therefore when you check if the key exists, it does. You need to add the Value property as the key.
The reason aa_dd's answer works is because it stores the value in a variable and then uses that value as the key, i.e. not the Field object.
An alternative approach is to explicitly use the Value property of the Field object...
With UserList
If Not .Exists(rs("Alias").Value) Then
.Add Key:=rs("Alias").Value, Item:=USArr
End If
End With
store rs("Alias") in a variable and then use that variable as key.
dim sKey as String
With UserList
sKey=rs("Alias")
If Not .Exists(sKey) Then
.Add sKey,USArr
End If
End With
Related
Follow Vba routine:
Dim CampoRS As string
Dim Requerido As Boolean
Dim Zero As Bollean
Dim rs As DAO.Recordset
With frmCurriculum
Set rs = dbCRM.OpenRecordset("SELECT * FROM tblCurriculum", dbOpenDynaset, dbSeeChanges, dbPessimistic)
rs.MoveFirst
For n = 0 To .Controls.Count - 1
CampoRS = .Controls.item(n).Tag
Requerido = rs.Fields(CampoRS).Required
Zero = rs.Fields(CampoRS).AllowZeroLenght
...
Using DAO, this routine get the properties "Required" and "AllowZeroLenght" of a field in a recordset.
I need get the same properties but using ADO
If you look here https://flylib.com/books/en/3.9.1.29/1/ you can see that the Field.Attributes property is a bitmask, so you can check for example
(rs.Fields("Name").Attributes and 64) = 64
(or use the adFldMayBeNull ADO constant) to check if a field is nullable, but I don't see the equivalent for "allow zero length" there.
This might be a case where you need to DAO/ADOX if you want both of those properties though.
I'm writing a macro to set categories/series names. New labels are taken from some dictionaries. My first step however was to get those names from each chart. So, in order to get it, I used the code below:
'works fine
'x - any integer
'whole sentence
Application.ActivePresentation.Slides(x).Shapes(x).Chart.ChartGroups(x).CategoryCollection(x).Name
'with variables
Dim objChart As Chart
Dim objChartGroups As ChartGroups
Dim objChartGroup As ChartGroup
Dim objCategoriesColl As CategoryCollection
Dim objCategory As ChartCategory
Dim strCategory As String
Set objChart = ActivePresentation.Slides(x).Shapes(x).Chart
Set objChartGroups = objChart.ChartGroups(x)
Set objChartGroup = objChartGroups.Item(x)
Set objCategoriesColl = objChartGroup.CategoryCollection
Set objCategory = objCategoriesColl(x)
strCategory = objCategory.Name
I checked this property (Name) many times on Microsoft Docs (https://learn.microsoft.com/office/vba/api/powerpoint.chartcategory.name) and it is stated that it is a read/write property. However, when I try to set a new name (in the code below) I receive an error. Is it possible there's a mistake in Docs?
Public Sub EnterNewChartCats( _
lngCategoriesCount As Long, _
objCategoriesColl As CategoryCollection, _
dctDT As Dictionary, _
dctConsts As Dictionary, _
dctRegexes As Dictionary, _
dctUniques As Dictionary)
'lngCategoriesCount - number of categories in a chart
'objCategoriesColl - CategoryCollection object (a list of categories)
'dctDT - a dictionary for names where there's no need to change the label
'dctConsts - a dictionary for non-unique names which appear many times in a presentation
'dctRegexes - a dictionary for names which can be replaced using regular expressions
'dctUniques - a dictionary for names taken from an Excel file (already done)
'booleans for check if a name appears in a dictionary
Dim blnInDT As Boolean
Dim blnInConsts As Boolean
Dim blnInRegexes As Boolean
Dim blnInUniques As Boolean
Dim blnAdd As Boolean
'creating standard variables
Dim objCategory As ChartCategory
Dim i As Long
Dim strCategory As String
Dim strUCaseToCheck As String
For i = 1 To lngCategoriesCount
Set objCategory = objCategoriesColl(i)
strCategory = Trim(objCategory.Name)
'trimmed and upper-case category string to compare with dictionary keys
strUCaseToCheck = UCase(strCategory)
'checking if a category appears in a dictionary
blnInDT = blnInDct(dctDT, strUCaseToCheck)
blnInConsts = blnInDct(dctConsts, strUCaseToCheck)
blnInRegexes = blnAnyValueLikeDctRegex(strUCaseToCheck, dctRegexes)
blnInUniques = blnInDct(dctUniques, strUCaseToCheck)
'checking if a category meets a condition - at least 1 occurrence in any dictionary
blnAdd = blnAnyValue(True, blnInConsts, blnInRegexes, blnInUniques)
'blnAlphabeticChars - a function to check if a category has any letters because
'there's no need to change such labels as '2021' etc.
If Not blnInDT And blnAdd And blnAlphabeticChars(strCategory) Then
'ERROR (objCategory.Name): Can't assign to read-only property
If blnInConsts Then
objCategory.Name = dctConsts(strUCaseToCheck)
ElseIf blnInRegexes Then
objCategory.Name = dctRegexes(strUCaseToCheck)
ElseIf blnInUniques Then
objCategory.Name = dctUniques(strUCaseToCheck)
End If
End If
Next i
Set objCategory = Nothing
End Sub
I've found a workaround (SeriesCollection(x).Values or .XValues) but it's not convenient to use. So, my question is: does exist any way to use Name to set new labels? If no - do you know other workarounds?
EDIT: I've finally managed to change labels via objChart.ChartData.Workbook but it's very slow and, more importantly, a workbook has to be activated (opened) in order to refresh categories/series names. That influenced performance and time of execution greatly so I'm still looking for any other way to do so.
Your first listing is trying to set the name of .CategoryCollection(1). But the help page that you linked to is about .ChartCategory.
In any case, here's how to set the category names:
ActivePresentation.Slides(1).Shapes(1).Chart.Axes(xlCategory).CategoryNames = Array("Test1", "Test2", "Test3", "Test4")
Objective: I'm building VBA code to filter through an address table SunstarAccountsInWebir_SarahTest. I want to loop through first and see if the address is "valid".
If it is not valid – export to different table.
If it is valid – it enters another nested if/then within "valid" address rows:
If their ID, external_nmad_id matches the ID of the second table 1042s_FinalOutput_7, I want to update one of the columns in the second table box13c_Address.
If it doesn't match an ID of the second table – it will be exported to a different table.
My problem is when I run my code it is returning
Run-Time error 3078: cannot find table or query
(it's breaking at the line where I compare the value of the cell (as string) against the DCount of table 2). If I remove the quotes around it I get a different error:
Type mismatch against the DCount
I feel like I'm missing something simple but can't tell what. How can I get my code to match a string value called in !external_nmad_id against the rest of the table called in my string? DCount("[ID]", StrSQL1)
Public Sub EditFinalOutput2()
'set variables
Dim i As Long
Dim qs As DAO.Recordset
Dim ss As DAO.Recordset
Dim StrSQL1 As DAO.Recordset
Dim IRSfileFormatKey As String
Dim external_nmad_id As String
Dim nmad_address_1 As String
Dim nmad_address_2 As String
Dim nmad_address_3 As String
Dim mytestwrite As String
'open reference set
Set db = CurrentDb
Set qs = db.OpenRecordset("SunstarAccountsInWebir_SarahTest")
'Set ss = db.OpenRecordset("1042s_FinalOutput_7")
'Set StrSQL1 = db.OpenRecordset("SELECT RIGHT(IRSfileFormatKey, 10) As ID
'FROM 1042s_FinalOutput_7;")
With qs.Fields
intCount = qs.RecordCount - 1
For i = 0 To intCount
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")
Set StrSQL1 = db.OpenRecordset("SELECT RIGHT(IRSfileFormatKey, 10) As ID FROM 1042s_FinalOutput_7;")
If !external_nmad_id = DCount("[ID]", StrSQL1) Then
ss.Edit
ss.Fields("box13c_Address") = qs.Fields("nmad_address_1") & qs.Fields("nmad_address_2") & qs.Fields("nmad_address_3")
ss.Update
Else: 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
qs.MoveNext
Next i
End With
'close reference set
qs.Close
Set qs = Nothing
ss.Close
Set ss = Nothing
End Sub
The issue is that the DCount function cannot operate directly against a Recordset.
You are declaring StrSQL1 as a RecordSet object and setting it to a RecordSet based on your Select statement.
Set StrSQL1 = db.OpenRecordset("SELECT RIGHT(IRSfileFormatKey, 10) As ID FROM 1042s_FinalOutput_7;")
You are then trying to pass this RecordSet to the DCount function which cannot accept a RecordSet object as the Domain parameter. As you can see in MSDN the DCount function requires a String parameter in the second position to define the "query" that you wish to "Count". Hence the 3078 error. When you remove the quotes around [ID] in your DCount line, you get Type Mismatch as a compile error because [ID] is not a String or String variable.
After you resolve that, you might want to reconsider your If statement. You haven't provided a sample of what kind of value !external_nmad_id will contain, other than the fact that it is a String value. The DCount function is going to return the number of rows found in the Domain (query) that you told it to count, so it appears you will be comparing a string (which may possibly contain alpha characters) to a number. Access will implicitly convert the DCount numeric result to a String for the sake of the comparison, but if your !external_nmad_id String is truly 10 characters or contains alpha characters, they will never match.
You cannot use a VBA recordset inside a domain aggregate like DCount as a string literal is required for table/query name argument. Simply save your query and then reference it by name in DCount.
SQL (save as query)
SELECT RIGHT(IRSfileFormatKey, 10) As ID FROM 1042s_FinalOutput_7;
VBA
If !external_nmad_id = DCount("[ID]", "mySavedQuery") Then
...
End If
I have an issue when populating a collection in VBA in MS Access.
Here's the code I have:
Private Sub loadInfo()
Dim sql As String
sql = "SELECT * FROM table2';"
Set db = CurrentDb
Set rs = db.OpenRecordset(sql)
With rs
.MoveFirst
While rs.EOF = False
Dim person As New person
Dim idToString As String
idToString = rs.Fields("ID").value
person.setFirstName (rs.Fields("first_name").value)
person.setLastName (rs.Fields("last_name").value)
people.Add person, idToString
.MoveNext
Wend
End With
End Sub
The collection is declared an initialized at the top of the class module. I can add items to it just fine. However, at the end of the Sub, I end up with a collection with the right amount of objects (however many I have in the Recordset,) but all of them with the same firstName and lastName.
Now, I thought that every time the "when" loop goes 'round, the variables inside of it would go out of scope, thus becoming null. In this case, that does not seem to be the case. Every time it gets back to person.setFirstName, the firstName of the item already in the collection changes to whatever the current firstName of the new row is. The same goes for lastName.
This leads me to believe that person is not being created every time the loop goes 'round, giving me a collection of similar entries, aside from their key which is unique.
Any ideas as to how to get the loop to perform as it should?
A collection is key-value paired list. It cannot have multiple dimensions.
Try using User Defined Types:
In module declarations...
Public Type Person
FirstName As String
LastName As String
End Type
In form declarations...
Dim typPerson() As Person
Then use like this...
ReDim typPerson(0 To rs.RecordCount - 1) As Person
Dim i As Integer
Do While Not rs.EOF
With typPerson(i)
.FirstName = rs!FirstName
.LastName = rs!LastName
End With
i = i + 1
rs.MoveNext
Loop
In your sub loadinfo(), insert the line:
“Set Person=Nothing”, before
“.MoveNext”.
If you don’t, the same item gets added to the collection the whole time.
HTH
I'm new to VBA and i need help.
I want to create vba function which takes table name as input, and distinct specific field from that table. I created function, and it works when i run it in vba immediate window (when i use debug.print command to display results). But when i call this function in sql, instead whole field values, it returns just last one. I'm not good at vba syntax so i need help to understand. Does function can return more than one value? If can, how, and if not what else to use? Here's my code:
Public Function TableInfo(tabela As String)
Dim db As Database
Dim rec As Recordset
Dim polje1 As Field, polje2 As Field
Dim sifMat As Field, pogon As Field, tipVred As Field
Set db = CurrentDb()
Set rec = db.OpenRecordset(tabela)
Set sifMat = rec.Fields("Field1")
Set pogon = rec.Fields("Field2")
Set tipVred = rec.Fields("Field3")
For Each polje1 In rec.Fields
For Each polje2 In rec.Fields
TableInfo = pogon.Value
rec.MoveNext
Next
Next
End Function
Any help is appreciated.
The problem is with this line probably:
TableInfo = pogon.Value
It runs inside the loop and returns the last value of the loop.
Instead of returning one value TableInfo, you may try to return something similar to a Collection or an Array.
Inside the loop, append values in the Collection and after the loop, return the Collection back from the function.
Edit:
I have re-written the code shared by you:
Public Function TableInfo(tabela As String) as String()
Dim db As Database
Dim rec As Recordset
Dim polje1 As Field, polje2 As Field
Dim sifMat As Field, pogon As Field, tipVred As Field
Dim returnValue() As String
Dim i as Integer
Set db = CurrentDb()
Set rec = db.OpenRecordset(tabela)
Set sifMat = rec.Fields("Field1")
Set pogon = rec.Fields("Field2")
Set tipVred = rec.Fields("Field3")
' I am not going to modify this but I think we can do away with two For Each loops.
' Just iterate over rec like
' For Each r In rec -> please use proper naming conventions and best practices
' and access each field as r("Field1") and r("Field2")
For Each polje1 In rec.Fields
For Each polje2 In rec.Fields
returnValue(i) = pogon.Value
i = i + 1
rec.MoveNext
Next
Next
TableInfo = returnValue
End Function
Please note: I have not tested this code but I assume this should work for you. Also, I have assumed that you want to return String() array. Please change the data type if you want to return some other type.
When you call the array (as posted in theghostofc's answer), you will need to do something like this:
Dim TableInfo() As String
For i = LBound(TableInfo) To UBound(TableInfo)
YourValue = TableInfo(i)
... Process some code that uses YourValue
Next i
If you're not looping through your array, you're not going to get each individual value out of it.