使用 Application.ontime 循环答案

【问题标题】：Looping with Application.ontime使用 Application.ontime 循环
【发布时间】：2015-08-17 21:36:53
【问题描述】：

我正在尝试循环下面的函数。目标是将 PDF 文件复制并粘贴到单独的工作表上。但是，基本的复制和粘贴功能有效，当我尝试循环时，它会在移动到下一个 Private Sub 之前执行每个 Private Sub 3 次。例如，在 Private Sub SecondStep 连续三次尝试从同一个 PDF 复制粘贴之前。

任何人都可以帮助如何正确循环这个吗？

Sub PDF_Copy_Paste_Loop()

Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe
Dim myfile As String
Dim i As Integer

i = 1

Do While i < 4


AppActivate "Tests - Excel"

Workbooks("tests").Sheets("Sheet1").Activate

myfile = Cells(i, 1)

AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 10.0\Acrobat\Acrobat.exe"
AdobeFile = "C:\Users\klanders\Desktop\" & myfile & ".pdf"

StartAdobe = Shell("" & AdobeApp & " " & AdobeFile & "", 1)

Application.OnTime Now + TimeValue("00:00:02"), "FirstStep2"
i = i + 1

Loop



End Sub

Private Sub FirstStep()

SendKeys ("^a")
SendKeys ("^c")

Application.OnTime Now + TimeValue("00:00:04"), "SecondStep2"

End Sub

Private Sub SecondStep()

AppActivate "Book1 - Excel"
Workbooks("Book1").Sheets("Sheet" & i).Activate

Range("A1").Select

SendKeys ("^v")

Application.OnTime Now + TimeValue("00:00:06"), "ThirdStep2"


End Sub

Private Sub ThirdStep()

Sheets.Add

End Sub

【问题讨论】：

标签： vba excel pdf

【解决方案1】：

也许这会有所帮助（未经测试）

Option Explicit

Sub PDF_Copy_Paste_Loop()
    Dim AdobeApp As String, AdobeFile As String
    Dim i As Long, ws As Worksheet, wb As Workbook

    'out of the loop (static value)
    AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 10.0\Acrobat\Acrobat.exe"

    Set wb = Workbooks("Book1")
    Set ws = Workbooks("tests").Worksheets("Sheet1")
    i = 1
    Do While i < 4
        AdobeFile = "C:\Users\klanders\Desktop\" & ws.Cells(i, 1).Value2 & ".pdf"
        Shell AdobeApp & " " & AdobeFile, 1
        Application.Wait Now + TimeValue("0:00:02") 'pause 2 seconds
            SendKeys "^a"
            SendKeys "^c"
        Application.Wait Now + TimeValue("0:00:02")
            AppActivate "Book1 - Excel"
            wb.Worksheets(i).Range("A1").Select
            SendKeys "^v"
        Application.Wait Now + TimeValue("0:00:02")
        wb.Worksheets.Add
        i = i + 1
    Loop
End Sub

【讨论】：