ADODB sometimes does not record data

Question

I'm new on this ADODB thing. I hope my question is not so silly. I open an ADODB connection from an Excel sheet (user interface) to another one ("database"). The code runs perfectly, but sometimes the updated or inserted data won't record in the database sheet. I don't know why and I don't know how to check it to avoid it happen. I do know that if I open the database sheet, save and then close, it works well again. Do someone know the reason for that?

The procedures of the code work well and the Excel VBA debugger does not get any error... Then I post some parts that I believe where the problem might be...

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

It takes some values from userform textboxes. It runs on a 2013 32 bits Excel version in Windows 10. The Microsoft ActiveX Data Objects 6.1 and Microsoft ActiveX Data Objects Recordset 6.0 libraries are activated. The interface is .xlsm and database is .xlsx

Answer 1

It sounds like you are trying to import data from a closed workbook. I haven't tried this in quite a while, but it sounds like the Macro Recorder is aware or the workbook that you are recording in/from, so the local workbook, but not the foreign workbook, so it loses references to the foreign workbook. See the code samples below.

 Import data from a closed workbook (ADO)

If you want to import a lot of data from a closed workbook you can do this with ADO and the macro below. If you want to retrieve data from another worksheet than the first worksheet in the closed workbook, you have to refer to a user defined named range. The macro below can be used like this (in Excel 2000 or later):

GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "A1:B21", ActiveCell, False
GetDataFromClosedWorkbook "C:\FolderName\WorkbookName.xls", "MyDataRange", Range ("B3"), True

Sub GetDataFromClosedWorkbook(SourceFile As String, SourceRange As String, _
    TargetRange As Range, IncludeFieldNames As Boolean)
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
'   this will return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
'   this will return data from any worksheet in SourceFile
' SourceRange must include the range headers
'
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
Dim TargetCell As Range, i As Integer
    dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};" & _
        "ReadOnly=1;DBQ=" & SourceFile
    Set dbConnection = New ADODB.Connection
    On Error GoTo InvalidInput
    dbConnection.Open dbConnectionString ' open the database connection
    Set rs = dbConnection.Execute("[" & SourceRange & "]")
    Set TargetCell = TargetRange.Cells(1, 1)
    If IncludeFieldNames Then
        For i = 0 To rs.Fields.Count - 1
            TargetCell.Offset(0, i).Formula = rs.Fields(i).Name
        Next i
        Set TargetCell = TargetCell.Offset(1, 0)
    End If
    TargetCell.CopyFromRecordset rs
    rs.Close
    dbConnection.Close ' close the database connection
    Set TargetCell = Nothing
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Sub
InvalidInput:
    MsgBox "The source file or source range is invalid!", _
        vbExclamation, "Get data from closed workbook"
End Sub

Another method that doesn't use the CopyFromRecordSet-method

With the macro below you can perform the import and have better control over the results returned from the RecordSet.

Sub TestReadDataFromWorkbook()
' fills data from a closed workbook in at the active cell
Dim tArray As Variant, r As Long, c As Long
    tArray = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21")
    ' without using the transpose function
    For r = LBound(tArray, 2) To UBound(tArray, 2)
        For c = LBound(tArray, 1) To UBound(tArray, 1)
            ActiveCell.Offset(r, c).Formula = tArray(c, r)
        Next c
    Next r
    ' using the transpose function (has limitations)
'    tArray = Application.WorksheetFunction.Transpose(tArray)
'    For r = LBound(tArray, 1) To UBound(tArray, 1)
'        For c = LBound(tArray, 2) To UBound(tArray, 2)
'            ActiveCell.Offset(r - 1, c - 1).Formula = tArray(r, c)
'        Next c
'    Next r
End Sub

Private Function ReadDataFromWorkbook(SourceFile As String, SourceRange As String) As Variant
' requires a reference to the Microsoft ActiveX Data Objects library
' if SourceRange is a range reference:
'   this function can only return data from the first worksheet in SourceFile
' if SourceRange is a defined name reference:
'   this function can return data from any worksheet in SourceFile
' SourceRange must include the range headers
' examples:
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:A21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "DefinedRangeName")
Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset
Dim dbConnectionString As String
    dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & SourceFile
    Set dbConnection = New ADODB.Connection
    On Error GoTo InvalidInput
    dbConnection.Open dbConnectionString ' open the database connection
    Set rs = dbConnection.Execute("[" & SourceRange & "]")
    On Error GoTo 0
    ReadDataFromWorkbook = rs.GetRows ' returns a two dim array with all records in rs
    rs.Close
    dbConnection.Close ' close the database connection
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Function
InvalidInput:
    MsgBox "The source file or source range is invalid!", vbExclamation, "Get data from closed workbook"
    Set rs = Nothing
    Set dbConnection = Nothing
End Function

See the link below.

https://www.erlandsendata.no/english/index.php?d=envbadacimportwbado

Check out this link as well.

https://www.rondebruin.nl/win/s3/win024.htm