Отчетов SQL опасности для выбранных процессов


Я написал код в VBA, чтобы помочь нашим отделом НИОКР. Я переместил все избыточные и статической информации в базу данных для них, чтобы искать, а затем создать отчет.

Я прикрепил btn_OK_Click() суб от моего пользователя форме. Как только пользователь нажимает кнопку, форма идет по списку "процессы", которые пользователь выбирает из Listview контроль в форме. Как только он получает список процессов, то он запрашивает у СС ДБ, чтобы получить соответствующую информацию.

Код работает, но когда начинаю в диапазоне от 30 и более "процессы", он замедляется. Я думаю, что это как-то связано с тем, как я зацикливание через процессы.

Ниже btn_OK_Click() С моей пользовательской формы и мой Process класс. Пожалуйста, дайте мне знать, если я закодирован код SQL так эффективно, как мог бы.

Private Sub btn_OK_Click()

    'get confirmation
    If MsgBox("Generate Hazard Analasys?", vbYesNo, "Confirm") = vbCancel Then
        Unload Me
        Exit Sub
    End If

    'Set up the connection
    Set HazardConn = New Connection
    Set HazardSet = New Recordset

    'Open the connection to the database
    On Error GoTo FORMCONNECTIONERROR
        HazardConn.Open CONNSTRING
    On Error GoTo 0

    'Declare Variables
    Dim SQLstring As String         'SQL Command, to be built and passed to the database
    Dim processIDs As Collection    'List of process names to be appended to the SQL String
    Dim procID As Variant           'Individual Process Name
    Dim hazardList As ListObject    'Table (Found in the "Hazard Analysis" Worksheet)
    Dim newProcess As Process       'Process Class - holds all relevant Process attributes
    Dim selRow As Long              'Individual row in the ListView of the form

    'Disable Screen updating, calculation and events
    OptimizeSpeed

    'Initialize
    Set processIDs = New Collection
    On Error GoTo TABLENOTFOUNDERROR
        Set hazardList = HazardSheet.ListObjects("tbl_Hazard")
    On Error GoTo 0

    'Reset the List
    On Error Resume Next
        hazardList.DataBodyRange.Rows.Delete
    On Error GoTo 0

    'Initialize the SQL String
    SQLstring = "SELECT * FROM dbo.Hazard_List WHERE ProcessName IN("

    'Append the SQL String and list the Process Names
    On Error GoTo GENERATEDLISTERROR

        With Me.list_Generated

            For selRow = 0 To Me.list_Generated.ListCount - 2
                SQLstring = SQLstring & "'" & .List(selRow) & "', "
                processIDs.Add .List(selRow)
            Next selRow

            SQLstring = SQLstring & "'" & .List(selRow) & "')"
            processIDs.Add .List(selRow)

        End With

    On Error GoTo 0

    'Open the RecordSe
    On Error GoTo FORMCONNECTIONERROR
        HazardSet.Open SQLstring, HazardConn, adOpenStatic, adLockOptimistic, adCmdText
    On Error GoTo 0

    'Add the Processes to the Hazard Analysis Table
    For Each procID In processIDs

        'Initialize the Process class
        Set newProcess = New Process
        newProcess.ProcessID = procID

        'Filter the recordset by the Process Name
        HazardSet.Filter = "ProcessName = '" & procID & "'"

        'Loop through the filtered records to append all hazards and risks to the Process class
        On Error GoTo RECORDSETREADERROR

            HazardSet.MoveFirst
            Do Until HazardSet.EOF

                'Declare local variables
                Dim hazType As String       'Hazard type (Biological, Chemical, Physical)
                Dim hazName As String       'Description of the hazard
                Dim hazRisk As Boolean      'Indicates if the hazard is a risk
                Dim hazJustify As String    'Justification for the hazard risk
                Dim hazPrevent As String    'Control Measures applied to the hazard
                Dim ccp As Boolean          'CCP Indicator


                'Initialize local variables
                hazType = Mid(CStr(HazardSet("HazardType").Value), 1, 1)
                hazName = HazardSet("HazardName")
                hazRisk = IIf(IsNull(HazardSet("RiskToConsumer")) Or HazardSet("RiskToConsumer") = 0, False, True)
                hazJustify = IIf(IsNull(HazardSet("Justification")), "", HazardSet("Justification"))
                hazPrevent = IIf(IsNull(HazardSet("ControlMeasure")), "", HazardSet("ControlMeasure"))
                ccp = IIf(IsNull(HazardSet("CCP")) Or HazardSet("CCP") = 0, False, True)

                'Pass information into the Process class to be appended to its individual attributes
                newProcess.AddHazard hazType, hazName, hazRisk, hazJustify, hazPrevent

                HazardSet.MoveNext
            Loop

        On Error GoTo 0

        'Add the entire process to the Hazard Table
        On Error GoTo LOADTABLEERROR

            With hazardList
                .ListRows.Add
                .ListColumns(2).DataBodyRange(.ListRows.Count).Value = newProcess.ProcessID
                .ListColumns(3).DataBodyRange(.ListRows.Count).Value = newProcess.Hazards
                .ListColumns(4).DataBodyRange(.ListRows.Count).Value = newProcess.Risks
                .ListColumns(5).DataBodyRange(.ListRows.Count).Value = newProcess.Justifications
                .ListColumns(6).DataBodyRange(.ListRows.Count).Value = newProcess.Preventions
                .ListColumns(7).DataBodyRange(.ListRows.Count).Value = IIf(ccp, "Yes", "No")
                .ListColumns(1).DataBodyRange(.ListRows.Count).EntireRow.AutoFit
            End With

        On Error GoTo 0

    Next procID

    '''''''''''''
    '''CLEANUP'''
    '''''''''''''

    'Unload the form
    Unload Me

    'Dispose of the Connections
    HazardSet.Close
    HazardConn.Close

    Set HazardSet = Nothing
    Set HazardConn = Nothing

    'Reenable screen updating, calculation and events
    ResetApp

    Exit Sub


'Connection error - Will exit the sub if we cannot connect to the database
FORMCONNECTIONERROR:
    MsgBox "There was an error connecting to the database. Please consult your designated support professional", vbCritical, "Error"
    Debug.Print "Connection Error: " & Err.Number & " - " & Err.Description
    Set HazardConn = Nothing
    Set HazardSet = Nothing
    ResetApp
    Exit Sub

'Table not found error - Will unload the form if the table has been renamed or deleted
TABLENOTFOUNDERROR:
    MsgBox "The Table that houses all Processes has been either renamed or deleted. Please consult your designated support professional", vbCritical, "Error"
    Debug.Print "Table Not Found Error: " & Err.Number & " - " & Err.Description
    Set HazardConn = Nothing
    Set HazardSet = Nothing
    ResetApp
    Unload Me
    Exit Sub

'Generated List Error - Will exit the sub if the Generated List is blank, or throws some other errors
GENERATEDLISTERROR:
    MsgBox "Error getting generated list", vbExclamation, "Error"
    Debug.Print "Generated List Error: " & Err.Number & " - " & Err.Description
    Set HazardConn = Nothing
    Set HazardSet = Nothing
    ResetApp
    Exit Sub

'Recordset reading error - Will exit the sub if there was an issue reading the SQL Query
RECORDSETREADERROR:
    MsgBox "There was an error loading the Processes. Please consult your designated support professional", vbCritical, "Error"
    Debug.Print "Recordset Error: " & Err.Number & " - " & Err.Description
    Set HazardConn = Nothing
    Set HazardSet = Nothing
    ResetApp
    Exit Sub

'Load table error - Will exit the sub if there was an issue loading the table
LOADTABLEERROR:
    MsgBox "There was an error filling the table", vbCritical, "Error"
    Debug.Print "Load Table Error: " & Err.Number & " - " & Err.Description
    Set HazardConn = Nothing
    Set HazardSet = Nothing
    ResetApp
    Exit Sub

End Sub

Process класс:

Private procID As String
Private hazardString As String
Private riskString As String
Private justString As String
Private preventString As String
Private procCCP As Boolean

Private bioCount As Long
Private chemCount As Long
Private physCount As Long


Public Property Get ProcessID() As String
    ProcessID = procID
End Property
Public Property Let ProcessID(val As String)
    procID = val
End Property

Public Property Get Hazards() As String
    Hazards = hazardString
End Property
Public Property Let Hazards(val As String)
    hazardString = val
End Property

Public Property Get Risks() As String
    Risks = riskString
End Property
Public Property Let Risks(val As String)
    riskString = val
End Property

Public Property Get Justifications() As String
    Justifications = justString
End Property
Public Property Let Justifications(val As String)
    justString = val
End Property

Public Property Get Preventions() As String
    Preventions = preventString
End Property
Public Property Let Preventions(val As String)
    preventString = val
End Property

Public Property Get ccp() As Boolean
    ccp = procCCP
End Property
Public Property Let ccp(val As Boolean)
    procCCP = val
End Property

Public Sub Init(id As String, c As Boolean)

    procID = id
    bioCount = 0
    chemCount = 0
    physCount = 0
    procCCP = c

End Sub

Public Sub AddHazard(hazType As String, hazName As String, hazRisk As Boolean, hazJustify As String, hazPrevent As String)

    Dim hazRiskString As String
    Dim cString As String
    Dim cCount As Long: cCount = 0
    Dim newLine As Boolean

    hazRiskString = IIf(hazRisk, "Yes", "No")
    newLine = True

    Select Case hazType
        Case "B":
            bioCount = bioCount + 1
            cCount = bioCount

        Case "C":
            chemCount = chemCount + 1
            cCount = chemCount

        Case "P":
            physCount = physCount + 1
            cCount = physCount
            newLine = False

    End Select

    cString = hazType & cCount
    appendStrings cString, hazName, hazRiskString, hazJustify, hazPrevent, newLine


End Sub

Private Sub appendStrings(catString As String, hazName As String, hazRiskString As String, hazJustify As String, hazPrevent As String, addNewLine As Boolean)

    Dim newLine As String: newLine = IIf(addNewLine, vbNewLine, "")

    If Not hazName = "None Identified" Then

        hazardString = hazardString & catString & " - " & hazName & newLine
        riskString = riskString & catString & " - " & hazRiskString & newLine
        If Not hazJustify = vbNullString Then
            justString = justString & catString & " - " & hazJustify & newLine
        End If

        If Not hazPrevent = vbNullString Then
            preventString = preventString & catString & " - " & hazPrevent & newLine
        End If

    End If


End Sub


166
1
задан 15 февраля 2018 в 03:02 Источник Поделиться
Комментарии
1 ответ

Последовательность и наименования

В VBA подчеркивания в суб и имена функций являются зарезервированными для наследования. Поскольку привязка действий к контролю, как правило, не связанные с наследством, btn_OK_Click должны быть названы okClick или OkClickв зависимости от того, какой вы предпочитаете.

Я предполагаю, что у вас есть Option Explicit указан. Если нет, то вы должны исправить это немедленно, чтобы избежать ошибки при написание переменных.

obtw: SQLstring наверное, должен быть назван что-то вроде sqlQuery. Чтобы избежать повторения typename и немного более явной. SQL также может быть оператор определения данных или обновления.

Кроме того, я настоятельно рекомендую переименование полей Process чтобы не включать тип и не быть ярлыки. Это просто намного легче читать таким образом:

Private processId As String
Private hazards As String
Private risks As String
Private justifications As String
Private preventions As String
Private cpp As Boolean ' no clue what this stands for...

Private biologicalCount As Long
Private chemicalCount As Long
Private physicalCount As Long

Упрощений


IIf(IsNull(HazardSet("RiskToConsumer")) Or HazardSet("RiskToConsumer") = 0, False, True)
IIf(IsNull(HazardSet("CCP")) Or HazardSet("CCP") = 0, False, True)

это эквивалентно:

Not IsNull(HazardSet("RiskToConsumer")) And HazardSet("RiskToConsumer") <> 0
Not IsNull(HazardSet("CPP")) And HazardSet("CPP") <> 0

Обратите внимание, что я уверен, что твоя обработка cpp это ошибка. Вы в настоящее время рассматривать только значение последней записи в "ЧГК". Что, кажется, не предполагается, что способ. Вместо этого вы, скорее всего, хотите иметь СРР остановиться, если это было на один раз. Если это так, вы должны изменить это назначение:

cpp = cpp Or ([...])

Я заметил, что вы никогда не использовать Process.Init. Если вы используете его где-то еще, вы можете игнорировать то, что я сказал, но вы должны удалить участников, которые не используются.

Повторение

Существует значительное повторение в способе обработки ошибок. Единственное, что действительно отличается-это сообщение в окне сообщения, и отладки.Заявление для печати.

Вы действительно должны рассмотреть следующее:

CLEANEXIT:
Unload Me
HazardSet.Close
HazardConn.Close

Set HazardSet = Nothing
Set HazardConn = Nothing
ResetApp
Exit Sub

FORMCONNECTIONERROR:
MsgBox [...]
Debug.Print [...]
Resume CLEANEXIT

TABLENOTFOUNDERROR:
MsgBox [..]
Debug.Print [..]
Resume CLEANEXIT

' I think you get the gist ;)

Читабельность

Последнее, но не менее я должен отметить, что текущая реализация немного трудно читать, потому что нет буквально никакой абстракции в этом. Он выполняет последовательность низкоуровневых шаги, выложенных в несколько мучительных подробностях.

Я очень рекомендую прочитать эту небольшую аналогию на то, что это делает, когда пытается прочитать код.

1
ответ дан 15 февраля 2018 в 04:02 Источник Поделиться