I see I call a function for DuplicateChildren so here this is.
Public Function DuplicateChildren() As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strsql As String
strsql = "SELECT Hierarchy" & strwho & ".[Child], Hierarchy" & strwho & ".[Parent], Hierarchy" & strwho & ".[HierCatID]" & _
" From Hierarchy" & strwho & _
" WHERE (((Hierarchy" & strwho & ".[Child]) In (SELECT [Child] FROM [Hierarchy" & strwho & "] As Tmp GROUP BY [Child] HAVING Count(*)>1 )))" & _
" ORDER BY Hierarchy" & strwho & ".[Child];"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strsql)
If rs.EOF Then
DuplicateChildren = ""
Else
DuplicateChildren = rs("Child")
End If
End Function
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Wednesday, November 02, 2016 8:52 AM
To: 'MS_Access_Professionals@yahoogroups.com'
Subject: RE: [MS_AccessPros] VBA Looping
Hey Jim, I wrote something similar and perhaps the code isn't that clean, but it works.
Here's my code:
Private Sub Form_Load()
On Error GoTo err_out
If strwho = "" Then
strwho = "Tucson"
End If
Dim strDups As String
strDups = DuplicateChildren
If strDups <> "" Then
MsgBox ("Can't run because there is a parent that has more than one child with the same name: " & strDups)
Exit Sub
End If
Dim db As DAO.Database
Dim rsLevel As DAO.Recordset
Dim rsemp As DAO.Recordset
Dim strsql As String
Set db = CurrentDb()
Dim theNode As Node
' get the nodes and parents to attach these nodes to
Dim intCLevel As Integer
intCLevel = 1
Dim checkNode As Node
' create the root node Full Site
Set theNode = Me.TreeView1.Nodes.Add(, , , "Full Site")
theNode.Key = "Full Site"
theNode.Tag = "Full Site"
' variables that might be redundant
Dim strPName As String
Dim strCname As String
' cycle down through the levels to match children to parents
While intCLevel > 0
' loop through level by level
strsql = "SELECT Child, Parent From Hierarchy" & strwho & " WHERE ChildLevel = " & intCLevel & ";"
Set rsLevel = db.OpenRecordset(strsql)
If Not rsLevel.EOF Then
While Not rsLevel.EOF
strPName = rsLevel!Parent
strCname = rsLevel!Child
Set theNode = Me.TreeView1.Nodes.Add(strPName, tvwChild, strCname, strCname)
theNode.Tag = strCname
rsLevel.MoveNext
Wend
intCLevel = intCLevel + 1
Else
intCLevel = 0
End If
Wend
' loop through different recordset to match employees to categories
strsql = "SELECT Employee, Supervisor, Child From unionHierarchyEmps" & strwho
Set rsemp = db.OpenRecordset(strsql)
While Not rsemp.EOF
strPName = rsemp!Child
strCname = rsemp!Employee & " - " & rsemp!Supervisor
Set theNode = Me.TreeView1.Nodes.Add(strPName, tvwChild, , strCname)
theNode.Tag = strCname
rsemp.MoveNext
Wend
Me.Refresh
GoTo exit_out
err_out:
MsgBox ("Error on load event " & Err.Number & vbCrLf & Err.Description)
exit_out:
Set theNode = Nothing
Set rsLevel = Nothing
Set rsemp = Nothing
Set db = Nothing
End Sub
From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Wednesday, November 02, 2016 8:41 AM
To: MS_Access_Professionals@yahoogroups.com
Subject: [MS_AccessPros] VBA Looping
Hello all,
I have a table that is used for the Reports to source for the Visio Org charts.
I am trying to figure out how to loop through a recordset multiple times.
I have a form with a combo box that allows the user to choose a Reports to employee.
My thought is that a loop could use the combo box to get the employees that report to the top Reports to needed. Then the loop could then get the employees that report to the name in the combo box. Then the loop would get all of the employees that report to the names under the name in the combo box until all records are retrieved.
Is it possible to do multiple loops?
Thank You
Jim Wagner
This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.
This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.
Posted by: Liz Ravenwood <Liz_Ravenwood@beaerospace.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (3) |
Tidak ada komentar:
Posting Komentar