为ADOBD SQL连接build立.RefreshPeriod

我有一个Excel电子表格连接到SQL并从表中提取数据。 我使用macroslogging器和SQL导入向导来做到这一点，但是我现在需要能够将数据写回到SQL，所以我遇到这个post，并试图使下面的代码工作。 它工作正常，但是我需要调整它，所以它刷新数据每分钟，所以用户几乎实时看到的数据。

在我logging的macros中，我可以设置一个.RefreshPeriod = 1参数，这样数据就会更新，我该怎么做呢？

（注意：还有其他的函数依赖于这里的variables，所以我需要保持它有点相同 – 这是用完整的代码写的）。

' General variables we'll need Public con As ADODB.Connection Public bIgnoreChange As Boolean Dim pk As New Collection Dim oldValue As Variant Dim nRecordCount As Integer Private Sub Workbook_SheetActivate(ByVal Sh As Object) ' Let's retrieve the data from the SQL Server table with the same name as the sheet bIgnoreChange = True Set con = New ADODB.Connection con.Provider = "sqloledb" sConnectionString = "Server=CONDO-HTPC;Database=Strat_sample;Trusted_Connection=yes;" ';UID="";Pwd="" " con.Open sConnectionString ' Clean up old Primary Key While (pk.Count > 0) pk.Remove 1 Wend ' Try to retrieve the primary key information On Error GoTo NoCon Set rs = con.Execute("SELECT COLUMN_NAME FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS AS tc INNER JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE AS kcu ON tc.CONSTRAINT_NAME = kcu.CONSTRAINT_NAME WHERE tc.CONSTRAINT_TYPE = 'PRIMARY KEY' AND tc.TABLE_NAME = '" & Sh.name & "'") 'Disable eventchange trigger in Workbook_SheetChange sub while this runs Application.EnableEvents = False ' Fill up the primary key infomration While (Not rs.EOF) pk.Add CStr(rs(0)) rs.MoveNext Wend ' Clean up the sheet's contents Sh.UsedRange.Clear ' Now get the table's data Set rs = con.Execute("SELECT * FROM " & Sh.name) ' Set the name of the fields Dim TheCells As Range Set TheCells = Sh.Range("A1") For i = 0 To rs.Fields.Count - 1 TheCells.Offset(0, i).Value = rs.Fields(i).name Next i ' Get value for each field nRow = 1 While (Not rs.EOF) For i = 0 To rs.Fields.Count - 1 TheCells.Offset(nRow, i).Value = rs(i) Next rs.MoveNext nRow = nRow + 1 Wend nRecordCount = nRow - 1 bIgnoreChange = (pk.Count = 0) And (nRecordCount > 0) 'Enable Workbook_SheetChange sub Application.EnableEvents = True Exit Sub NoCon: con.Close Set con = Nothing 'Enable Workbook_SheetChange sub Application.EnableEvents = True End Sub 

Answer 1

这很容易做到。 正如下面的Stackoverflow问题的答案中所述，您可以设置一个macros使用Application.OnTime间隔运行。 macros运行后，您设置另一个等待期，以便再次运行。

VBAmacros定时器样式运行代码每个集合的秒数，即120秒

此外，请确保在刷新数据时closures屏幕更新。

 Application.ScreenUpdating = False 

最后，如果使用连接string将其设置为查询表，您仍然应该能够运行此查询。 然后，您只需设置刷新率并称之为一天。