OLEDB连接没有刷新日期

Question

我需要以编程方式检查Excel到SQL表和视图中的许多OLEDB数据连接的刷新日期.它们都以相同的方式配置并使用相同的连接字符串,我在VBA中使用以下命令检查它们:

Connections.OLEDBConnection.RefreshDate

但是,少数这些连接没有刷新日期,我并不是说RefreshDate属性返回NULL,该属性甚至不存在.VBA抛出"应用程序定义或对象定义的错误",当我检查连接属性时,"上次刷新"字段为空:

无论我如何构建连接或刷新多少次,它与这些特定SQL表和视图的连接都是一致的.我坚持使用OLEDB,我们的一些机器与Power Query存在兼容性问题.有没有人知道在Excel或SQL中导致这个或我需要改变的是什么？

Answer 1

我还没有找到令人满意的解决方案，但是如果您非常需要知道连接已更新，这可能会对您有所帮助。这也可能取决于您拥有的连接类型。免责声明：此解决方案比专业解决方案更像是骇客，但似乎可以使用到现在。这是计划：

1虚拟显示器

在工作表中显示来自您的连接的数据。该工作表Sheet1可能是Hidden或VeryHidden。没关系。

2事件

修改Worksheet_Change事件，如下所示：

Private Sub Worksheet_Change(ByVal Target As Range)
RefreshDate (Now())
End Sub

3模数

最重要的是，您需要一个模块，该模块提供用于存储和访问RefreshDate另一张纸上的属性的功能。您可能要使用存储在Thisworkbook属性中的对象来执行此操作，但就我所知，这并不能避免损坏。

这里的代码：

Sub RefreshDate(D As Date)
Sheet2.Range("A1").Value = D
End Sub

Public Function GetRefreshDate() As Date
GetRefreshDate = Sheet2.Range("A1").Value
End Function

4冲洗并重复所有连接

现在，您需要对所有不适用于的连接执行此操作RefreshDate。您可能需要将所有日期保存在一个工作表中，并且每个连接都有一个工作表。

这个解决方案难看吗？是的。它行得通吗？是的，它确实。

基本思想如下：每次刷新连接时，工作表都会更改，这将触发事件：Worksheet_Change现在，您可以保存日期以便以后访问。

如果您发现只要刷新连接就可以访问事件的其他方法，这也可以解决问题。如果您发现其他保存方法RefreshDate，将可以解决问题。

Answer 2

如果refreshDate未填写，您可能不走运。

作为解决方法，您可以自己跟踪刷新。起点是afterRefresh表的事件。为此，您必须将以下代码添加到 -Module 中Workbook（不适用于常规模块，因为With Events需要class.

Option Explicit
Private WithEvents table As Excel.QueryTable

Private Sub table_AfterRefresh(ByVal Success As Boolean)
    Debug.Print table.WorkbookConnection.name & " refreshed. (success: " & Success & ")"
    If Success Then
        Call trackRefreshDate(table.WorkbookConnection.name, Now)
    End If
End Sub

现在您只需要一个逻辑来保存刷新事件。在我的示例中，我将其保存为工作簿级别的名称，当然您也可以将其保存在（隐藏）工作表中。将其放入常规模块中：

Sub trackRefreshDate(tableName As String)

    Dim nameObj As Name, nName As String
    Set nameObj = Nothing
    nName = "Refresh_" & tableName
    On Error Resume Next
    ' Check if name already exists
    Set nameObj = ThisWorkbook.Names(nName)
    On Error GoTo 0
    Dim v
    v = Format(Now, "dd.mm.yyyy hh:MM:ss")
    If nameObj Is Nothing Then
        ' No: Create new
        Call ThisWorkbook.Names.Add(nName, v)
    Else
        nameObj.Value = v
    End If
End Sub

Function getRefreshDate(tableName As String)
    Dim nName As String
    nName = "Refresh_" & tableName
    On Error Resume Next
    getRefreshDate = Replace(Mid(ThisWorkbook.Names(nName), 2), """", "")
    On Error GoTo 0        
End Function