AccessExcel VBA - 时间延迟

Question

注意：刷新Excel中与Access数据库链接的表格。

1. 刷新Excel中链接到Access数据库的表格。

2. Excel中的表格需要按顺序刷新，如Test_Sheet1、Test_Sheet2、Test_Sheet3。

3. Excel文件可由多个用户访问

问题

在Access vba中，如果一个excel文件正在使用中（只读），我如何在Access vba代码中实现延迟，以等待文件被读写，从而可以继续执行代码（刷新表格，保存关闭文件）。 请注意，Excel文件确实需要按顺序刷新。

我确实实现了一个带时间延迟的错误处理，所以如果错误编号=1004，那么延迟X.这并没有真正完成工作。

VBA中的时间延迟

Function RefreshExcelTables()


Dim ExcelApp As Object
Set ExcelApp = CreateObject("Excel.Application")

ExcelApp.workbooks.Open "c:\test\Test_Sheet1.xlsb"
ExcelApp.ActiveWorkbook.refreshall
ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWindow.Close


ExcelApp.workbooks.Open "c:\test\Test_Sheet2.xlsb"
ExcelApp.ActiveWorkbook.refreshall
ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWindow.Close


ExcelApp.workbooks.Open "c:\test\Test_Sheet3.xlsb"
ExcelApp.ActiveWorkbook.refreshall
ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWindow.Close



Set ExcelApp = Nothing


End Function

弹出式信息（图片如下

更新

Function RefreshExcelTables()

On Error GoTo Error

Dim ExcelApp As Object
Set ExcelApp = CreateObject("Excel.Application")

ExcelApp.workbooks.Open "c:\test\Test_Sheet1.xlsb"
ExcelApp.ActiveWorkbook.refreshall
ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWindow.Close


ExcelApp.workbooks.Open "c:\test\Test_Sheet2.xlsb"
ExcelApp.ActiveWorkbook.refreshall
ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWindow.Close


ExcelApp.workbooks.Open "c:\test\Test_Sheet3.xlsb"
ExcelApp.ActiveWorkbook.refreshall
ExcelApp.ActiveWorkbook.Save
ExcelApp.ActiveWindow.Close

Error:

If Err.Number = 1004 Then

call pause(5)

Resume

End If

Set ExcelApp = Nothing


End Function



Public Function Pause(intSeconds As Integer)

Dim dblStart As Double

If intSeconds > 0 Then

dblStart = Timer()

Do While Timer < dblStart + intSeconds

Loop

End If

End Function

Answer 1

我曾经用这个来暂停代码处理。

Public Function Pause(intSeconds As Integer)

    Dim dblStart As Double

    If intSeconds > 0 Then

        dblStart = Timer()

        Do While Timer < dblStart + intSeconds
            ' Twiddle thumbs
        Loop

    End If
End Function

所以你只需要： Call Pause(1) 无论你在哪里需要暂停，它都会等待一秒钟。

如果你只需要以整整一秒的增量来延迟，效果很好。 我有另一个更健壮的，有更多的代码，如果你想要的话，可以用它来代替更小的增量。

Answer 2

'这段代码使用定时器函数暂停正在运行的代码，对午夜（当定时器重置为0时）做出特殊规定。在MS Access中实现

 Public Sub Pause(NumberOfSeconds As Double)
On Error GoTo error_goto

Dim PauseInterval As Variant   'Pause interval is the wait time
Dim StartTime As Variant       'wait start time
Dim ElapsedInterval As Variant  'time elapsed from start time to now
Dim preMidnightInterval As Variant   'time interval from start time to midnight
Dim endTime As Variant

'initializing variables
PauseInterval = NumberOfSeconds
StartTime = Timer
ElapsedInerval = 0
preMidnightInterval = 0
endTime = StartTime + PauseInterval

Do While ElapsedInterval < PauseInterval
ElapsedInterval = Timer - StartTime + preMidnightInterval
'During the day premidnightInterval =0
'shortly after midnight is passed timer is almost 0 and preMidnightInterval becomes non zero
'detecting midnight switch
'the instant midnight is passed ElapsedInterval = 0 - starttime + 0
    If ElapsedInterval < 0 Then
    preMidnightInterval = 86400 - StartTime 'interval segment before midnight
    StartTime = 0       'reset start time to midnight
    End If
DoEvents

Loop
'Debug.Print "starttime " & StartTime & "elapsed interval " & ElapsedInterval & " timer:" & Timer & "endtime:" & endTime
Exit_GoTo:
'On Error GoTo 0
Exit Sub

error_goto:
Debug.Print Err.Number, Err.Description, er1
GoTo Exit_GoTo

End Sub