Looping with Application.ontime

Question

Я пытаюсь включить функцию ниже. Цель состоит в том, чтобы скопировать и вставить файлы PDF на отдельные рабочие листы. Основная функция копирования и вставки работает, однако, когда я пытаюсь выполнить цикл, он запускает каждый отдельный Sub 3 раза, прежде чем переходить к следующему частному Sub. Например, перед тем, как 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 

Answer 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