Question

我对ADODB还是陌生的。我希望我的问题不是那么愚蠢。我打开了从Excel工作表（用户界面）到另一个工作表（“数据库”）的ADODB连接。该代码可以完美运行，但是有时更新或插入的数据不会记录在数据库表中。我不知道为什么，也不知道如何检查以避免发生。我确实知道，如果我打开数据库工作表，然后保存然后关闭，它将再次正常工作。有人知道原因吗？

代码过程运行良好，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

它从用户窗体文本框中获取一些值。它在Windows 10中的2013 32位Excel版本上运行。Microsoft ActiveX数据对象6.1和Microsoft ActiveX数据对象Recordset 6.0库已激活。接口是.xlsm，数据库是.xlsx

Answer 1

听起来您正在尝试从封闭的工作簿中导入数据。我已经有一段时间没有尝试过了，但是听起来宏录制器知道了，或者您正在/从中录制工作簿，所以本地工作簿而不是外部工作簿，因此它丢失了对外部工作簿的引用。请参见下面的代码示例。

<div class="stack-20">
   <div>
       <div>...</div>
       <div>...</div>
   </div>
   <div class="stack-60">
       <div>...</div>
       <div>...</div>
   </div>
</div>

如果要从封闭的工作簿中导入大量数据，则可以使用ADO和下面的宏来完成。如果要从已关闭工作簿中的第一个工作表之外的另一个工作表中检索数据，则必须引用用户定义的命名范围。下面的宏可以这样使用（在Excel 2000或更高版本中）：

 Import data from a closed workbook (ADO)

另一种不使用CopyFromRecordSet方法的方法

使用下面的宏，您可以执行导入并更好地控制从RecordSet返回的结果。

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

请参阅下面的链接。

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

也请查看此链接。

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

ADODB有时不记录数据

1 个答案: