Я новичок в этой штуке 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