Rabu, 02 November 2016

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.

__._,_.___

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 (2)

Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.


.

__,_._,___

Tidak ada komentar:

Posting Komentar