Копирование данных из табеля учета рабочего времени в сводный лист без открытия файла сводки - дополнительная контрольная точка - PullRequest
0 голосов
/ 03 мая 2020

Ниже приведен код, который в основном копирует данные из одного листа Excel в другой лист Excel и прекрасно работает, выполняя свою работу. Я хочу получить дополнительный контроль в приведенном ниже коде.

В моем табеле времени я запретить людям обновлять информацию более чем за один день, например: если я обновляю информацию за 1 мая и если Excel содержит информацию за несколько дней (1,2,3,4 мая), она должна обновляться только за 1 мая. Любую логи c я могу добавить как команду ввода или ссылку на любую ячейку до даты с префиксом.

Sub UpdateSummary()

    Dim cn As Object, cm As Object, rs As Object
    Dim dte As Double, nme As String, activity As String, sub_activity As String, upt_time As Integer, comments As String
    Dim lr As Long
    Dim cc As Range

    On Error GoTo err_handler

    Set cn = CreateObject("ADODB.Connection")
    Set cm = CreateObject("ADODB.Command")

    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Properties("Data Source") = ThisWorkbook.Path & "\Summary-TimeSheet.xlsm"
        .Properties("Extended Properties") = "Excel 12.0 Macro; HDR=YES; IMEX=0"
        .Open
    End With

    cm.ActiveConnection = cn
    cm.CommandText = "SELECT Name,Date FROM [Summary$] WHERE Name = '" & ActiveSheet.Range("B2") & "' AND Date = " & CDbl(ActiveSheet.Range("A2"))
    Set rs = cm.Execute

    If Not (rs.BOF And rs.EOF) Then
        MsgBox "Data for this date has already been submitted", vbInformation
        Exit Sub
    End If

    With ActiveSheet
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row

        For Each cc In .Range("A2:A" & lr)
            dte = CDbl(cc.Offset(0))
            nme = cc.Offset(, 1)
            activity = cc.Offset(, 2)
            sub_activity = cc.Offset(, 3)
            upt_time = CDbl(cc.Offset(, 4))
            comments = cc.Offset(, 5)

            cm.CommandText = "INSERT INTO [Summary$] ([Date],[Name],[Activity],[Sub Activity],[UPT Time],[Comments]) VALUES (" & _
                              dte & ", " & _
                              "'" & nme & "', " & _
                              "'" & activity & "', " & _
                              "'" & sub_activity & "', " & _
                              upt_time & ", " & _
                              "'" & comments & "')"
            cm.Execute
        Next cc
    End With

exit_handler:
    Set rs = Nothing
    Set cm = Nothing
    Set cn = Nothing

Exit Sub

err_handler:
    MsgBox "Function UpdateSummary" & vbNewLine & vbNewLine & Err.Number & ": " & Err.Description, vbCritical, "Error in Function UpdateSummary"
    Resume exit_handler

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...