Вопрос VBA - чтение данных из базы данных Access и отображение списка компаний

Question

Я пытаюсь выполнить некоторую работу по кодированию VBA. У меня есть тикер в основной электронной таблице, который распознает пользователя каждой электронной таблицы и показывает соответствующий список компаний, назначенных им. Так что моим коллегам нужно будет ввести данные разных компаний в эту электронную таблицу, а затем записать данные в базу данных Access. В прошлом году мои коллеги выполнили ввод данных по некоторым компаниям за 2008–2018 годы, что означает, что компания имеет рекорд за каждый год в течение этого временного диапазона. В прошлом году в таблице было 2 вкладки для ввода данных, а в этом году в таблицу добавлено еще 5 вкладок. Поэтому моим коллегам нужно будет ввести дополнительные данные для 5 новых вкладок для одних и тех же компаний в период с 2008 по 2018 год. После этого им нужно будет ввести данные за 2019 год для этих компаний и начать с нуля (с вкладки 1 на вкладку 7 ). На главном листе есть кнопка «Редактировать запись», где они могут щелкнуть и импортировать данные из базы данных для записей данных, которые они сделали в прошлом году ...

Теперь мой вопрос: я хочу поле тикера чтобы показать неполный список компаний, если запись о компаниях была записана в базу данных прошлым летом (поскольку моим коллегам все еще нужно обновить вкладки T3 до T7). Если запись данных будет выполнена этим летом (мои коллеги обновят T3 до T7), запись компании в этом конкретном c году не будет отображаться в неполном контрольном списке. В одной из таблиц базы данных есть один столбец с именем «addeddatetime». Я хочу использовать эту информацию для сортировки компаний на полные и неполные. Итак, допустим, если запись о компании написана до 30.09.2019 23:59:59, я называю ее неполной. Не знаете, как выполнить кодирование для подключения электронной таблицы и базы данных, пожалуйста, помогите !! Любая помощь приветствуется. Я поместил код ниже - не уверен, что этого достаточно, чтобы вы, гуру, поняли ... но, пожалуйста, дайте мне знать, если вам понадобится дополнительная информация:

Вот код для тикера:

   Private Sub CommandButton1_Click()
        Call DoVersionCheck
        Dim db As DAO.Database, rst As Recordset
         DBFullName = "J:\happy\happy data Folder\happy DB.mdb"
        Set db = OpenDatabase(DBFullName, False, False, ";pwd=happy")
        Set rst = db.OpenRecordset("SELECT * FROM Tickers WHERE Active = " & "True" & " ORDER BY CompanyName Asc", dbReadOnly)
        'changes property
        For i = 0 To ListBox1.ListCount - 1
          If ListBox1.Selected(i) Then
                FULL_NAME = ListBox1.List(i)
                Sheets("Main").Range("TICKER") = Mid(FULL_NAME, WorksheetFunction.Find("(", FULL_NAME) + 1, Len(FULL_NAME) - WorksheetFunction.Find("(", FULL_NAME) - 1)

                Sheets("Main").Range("Happy1FRAC") = "0%"
                Sheets("Main").Range("Happy2EFRAC") = "0%"
                Sheets("Main").Range("Happy3FRAC") = "0%"
                Sheets("Main").Range("OTHERFRAC") = "0%"
                Sheets("Main").Range("OTHER_IQRE_NAME") = ""
                Do
                    If rst![Ticker] = Sheets("Main").Range("TICKER") Then
                        Sheets("Main").Range("COMPANYNAME") = rst![CompanyName]

                        If rst![Happy1ShareFrac] < 1 Then
                            Sheets("Main").Range("Happy1FRAC") = rst![Happy1hareFrac] * 100 & "%"
                            Sheets("Main").Range("Happy2FRAC") = "?%"
                            Sheets("Main").Range("Happy3FRAC") = "?%"
                            Sheets("Main").Range("OTHERFRAC") = "?%"
                            Sheets("Main").Range("OTHER_IQRE_NAME") = ""
                            MsgBox "XXXX."

                        Else

                            Sheets("Main").Range("Happy1FRAC") = rst![Happy1ShareFrac] * 100 & "%"
                            Sheets("Main").Range("Happy2FRAC") = "0%"
                            Sheets("Main").Range("Happy3FRAC") = "0%"
                            Sheets("Main").Range("OTHERFRAC") = "0%"
                            Sheets("Main").Range("OTHER_IQRE_NAME") = ""
                            MsgBox "XXX"
                        End If
                 Exit Do
            End If

                    rst.MoveNext
                Loop Until rst.EOF
                Unload Me
              Exit For
          End If
          If i = ListBox1.ListCount - 1 Then
                Exit Sub
          End If
      Next i

     Call write_log("Selected Ticker from database list (initiation).")
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub FilterDone_Click()
    Call reloadProperties
End Sub

Private Sub EvalYear_Change()
    ThisWorkbook.max_populate_priority_rank = Val(Me.TB1)
    Call UpdateTickers(ThisWorkbook.max_populate_priority_rank)
End Sub

Private Sub Label1_Click()

End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub ShowIncomplete_Click()
     ThisWorkbook.max_populate_priority_rank = Val(Me.TB1)
    Call UpdateTickers(ThisWorkbook.max_populate_priority_rank)
End Sub

Private Sub UserForm_Initialize()
    Me.Caption = "Choose ticker:"


    For y = 2019 To 2009 Step -1
        Me.EvalYear.AddItem (y)
    Next y

     Dim db As DAO.Database, rst As Recordset
    DBFullName = "J:\happy\happy data Folder\happy DB.mdb"
    Set db = OpenDatabase(DBFullName, False, False, ";pwd=happy")
    Set rst = db.OpenRecordset("SELECT * FROM Master ORDER BY PriorityYear Asc", dbReadOnly)
    use_year = 0
    ThisWorkbook.max_populate_priority_rank = 10
    Do
                If IsNull(rst![PriorityYear]) Then
                    use_year = 0
                    'Exit Do
                End If
                If Val(rst![PriorityYear]) > 0 Then
                    use_year = Val(rst![PriorityYear])

                    'Exit Do
                Else
                    use_year = 0
                End If


                 If IsNull(rst![MaxPopulatePriorityRank]) Then
                   ThisWorkbook.max_populate_priority_rank = 10
                    'Exit Do
                End If
                If Val(rst![MaxPopulatePriorityRank]) > 0 Then
                    ThisWorkbook.max_populate_priority_rank = Val(rst![MaxPopulatePriorityRank])

                    'Exit Do
                Else
                    ThisWorkbook.max_populate_priority_rank = 1
                End If
                Me.TB1 = ThisWorkbook.max_populate_priority_rank


                rst.MoveNext
    Loop Until rst.EOF

    If use_year = 0 Then
        Me.EvalYear.ListIndex = 0 ' Me.EvalYear.ListCount - 1
    Else
        Me.EvalYear = use_year
        'Me.EvalYear.Enabled = False
    End If

     Me.ShowIncomplete = True
     Call LoadTickers(ThisWorkbook.max_populate_priority_rank)





End Sub


Private Sub LoadTickers(max_populate_priority_rank)

    Call UpdateTickers(max_populate_priority_rank)



End Sub

Private Sub UpdateTickers(max_populate_priority_rank)
    Dim db As DAO.Database, rst As Recordset, rst2 As Recordset, rst3 As Recordset

DBFullName = "J:\happy\happy data Folder\happy DB.mdb"
    Set db = OpenDatabase(DBFullName, False, False, ";pwd=happy")
    Set rst = db.OpenRecordset("SELECT * FROM Tickers WHERE Active = " & "True" & " ORDER BY CompanyName Asc", dbReadOnly)
    Set rst2 = db.OpenRecordset("SELECT * FROM data_Summary WHERE EvaluationYear > " & "2008" & " ORDER BY Ticker Asc", dbReadOnly)
    Set rst3 = db.OpenRecordset("SELECT * FROM DataInputBounds ORDER BY UserName Asc", dbReadOnly)



    current_user_name = Get_UserName("Y")
    Debug.Print current_user_name, "---Herer----"



    If Me.ShowIncomplete = True Then
        do_net = True
        filter_year = Val(Me.EvalYear)
    Else
        do_net = False
    End If





    'clear listbox
    Me.ListBox1.Clear


    'filter_type = "TYPE_2" 'Type_1 is by letter; Type_2 is by allotment frac

    Debug.Print Allocated_Individual, "before With Me.ListBox1"

'    If allotment_type = 1 Then

            With Me.ListBox1
                 .Clear
                 Do
                 Allocated_Individual = rst![Allocated_Individual]
                  If current_user_name = Allocated_Individual Then
                    If rst![Sector] = "Oil & Gas" Then
                        If do_net = False Then
                            If rst![PopulatePriorityRank] <= max_populate_priority_rank Then
'                             If Asc(UCase(Mid(rst![CompanyName], 1, 1))) >= min_letter And Asc(UCase(Mid(rst![CompanyName], 1, 1))) <= max_letter And rst![PopulatePriorityRank] <= max_populate_priority_rank Then

                                    .AddItem rst![CompanyName] & " (" & rst![Ticker] & ")"
'                                End If

                            End If
                        Else

                            found = False
                            On Error Resume Next
                             rst2.MoveFirst

                            Do
                                If rst2![Initiator] = current_user_name Then
                                    If rst2![Ticker] = rst![Ticker] And rst2![evaluationyear] = filter_year Then
                                        found = True
                                        Exit Do
                                    End If
                                End If
                                rst2.MoveNext
                            Loop Until rst2.EOF

                            If found = True Then

                               If current_user_name = Allocated_Individual Then
                                .AddItem rst![CompanyName] & " (" & rst![Ticker] & ")"
                                'End If
                                'End If
                            End If

                        End If
                    End If
                    End If
                     rst.MoveNext

                 Loop Until rst.EOF
             End With



skipLoad:
     rst.Close
     db.Close
     Set rst = Nothing
     Set db = Nothing
End Sub