ADODB иногда не записывает данные - PullRequest
0 голосов
/ 19 ноября 2018

Я новичок в этой штуке ADODB. Я надеюсь, что мой вопрос не так глуп. Я открываю соединение ADODB из листа Excel (пользовательский интерфейс) с другим («база данных»). Код работает отлично, но иногда обновленные или вставленные данные не записываются в лист базы данных. Я не знаю почему, и я не знаю, как это проверить, чтобы этого не случилось. Я знаю, что если я открою лист базы данных, сохраню, а затем закрою, он снова будет работать хорошо. Кто-то знает причину этого?

Процедуры в коде работают хорошо, и отладчик Excel VBA не выдает никакой ошибки ... Затем я публикую некоторые части, в которых, я полагаю, может быть проблема ...

Public cn As ADODB.Connection
Public rst As ADODB.Recordset
Public sSQL As String

Public z, OP, Conf, TempoA, Setor As Double
Public FoundAp, FoundPar As Boolean

Private Sub txtCod_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Set cn = New ADODB.Connection
Set rst = New ADODB.Recordset

If Val(Application.Version) <= 11 Then 'Excel 2003 ou anterior
    cn.ConnectionString = _
      "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & EstaPasta_de_trabalho.DbPath & ";" & _
      "Extended Properties=Excel 8.0;"
Else 'Excel 2007 ou superior
    cn.ConnectionString = _
      "Provider=Microsoft.ACE.OLEDB.12.0;" & _
      "Data Source=" & EstaPasta_de_trabalho.DbPath & ";" & _
      "Extended Properties=Excel 12.0 Xml;"
End If
cn.Open

'Instrução Sql:
    sSQL = "SELECT * FROM [tb_Db_Ops$] " & _
        "WHERE Cod_Apont LIKE " & txtCod & ";"

    rst.CursorLocation = adUseServer
    rst.Open sSQL, cn, adOpenKeyset, adLockOptimistic, adCmdText

    If Not rst.EOF And Not rst.BOF Then
        OP = rst!OP
        frmApontamento.Visible = True
        txtApontA = txtCod.Text
        txtOpA = OP
        txtEtapa.Text = rst!Etapa
        txtDocA = rst!Documento
        txtObraA = Mid(rst!Obra, 12)
        Setor = CDbl(rst!Setor)
        If IsNull(rst!Status) = False Then
            Status = rst!Status
        End If
        If Status = "FINALIZADO" Then
            frmMsg.lblMsg.Caption = "OP já finalizada!"
            frmMsg.Show
            rst.Close
            cn.Close
            Set rst = Nothing
            Set cn = Nothing
            Exit Sub
        ElseIf Status = "EM EXECUÇÃO" Then
            FoundAp = True
            FoundPar = False
        ElseIf Status = "" Then
            FoundAp = False
            FoundPar = False
        Else
            FoundAp = True
            FoundPar = True
        End If
    Else
        frmMsg.lblMsg.Caption = "Apontamento NÃO encontrado na Base de Dados! Supervisão notificada! Tente novamente mais tarde!"
        frmMsg.Show
        Email.ErroBd = True
        Email.ErroGrav = False
        Email.Proced = "txtCod_Exit"
        Call Email_Erros
        rst.Close
        cn.Close
        Set rst = Nothing
        Set cn = Nothing
        Exit Sub
    End If

    rst.Close

sSQL = "UPDATE [tb_Apontamentos$] " & _
        "SET dt_f = NOW(), dt = NOW() - dt_i " & _
        "WHERE Cod_Apont LIKE " & txtApontR & " AND dt_f IS NULL;"

cn.Execute sSQL

Final:
If Not (rst Is Nothing) Then
    If rst.State = 1 Then
        rst.Close
    End If
    Set rst = Nothing
End If

If Not (cn Is Nothing) Then
    If cn.State = 1 Then
        cn.Close
    End If
    Set cn = Nothing
End If
end sub

Он принимает некоторые значения из текстовых полей пользовательской формы. Он работает в 32-разрядной версии Excel 2013 года в Windows 10. Активируются библиотеки Microsoft ActiveX Data Objects 6.1 и Microsoft ActiveX Data Objects Recordset 6.0. Интерфейс .xlsm и база данных .xlsx

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