VBA，AppActivate Microsoft Excel

Question

我正在尝试使用发送键将pdf复制到excel。 但是，我的SecondStep子项出现编译错误

Sub StartAdobe()

Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe

AdobeApp = "location of adobe reader"
AdobeFile = "file location"

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

Application.OnTime Now + TimeValue("00:00:10"), "FirstStep"

End Sub

Private Sub FirstStep()

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

Application.OnTime Now + TimeValue("00:00:20"), "SecondStep"



   End Sub

    Private Sub SecondStep()

    Workbooks("testy").Activate
AppActivate "Microsoft Excel"

    Range("A1").Activate
    SendKeys ("^v")

    End Sub

有人知道我在做什么错吗？ 在secondsub之前，一切正常。

Answer 1

也许下面的代码会起作用

Private Sub SecondStep()

    AppActivate Application.Caption
    Workbooks("testy").Activate

    Range("A1").Activate
    SendKeys ("^v")

End Sub

Answer 2

AppActivate接受窗口/应用程序的标题/标题。 （不是应用程序的名称。）打开文件后，使用AppActivate Dir(AdobeFile)激活窗口。

这是因为，如果您的AdobeFile = "C:\\Temp\\Some PDF.pdf"那么您的Adobe窗口将具有标题“ Some PDF.pdf-Adobe Reader”或“ Some PDF.pdf-Adobe Acrobat”，以及Dir(AdobeFile)将是“ Some PDF.pdf”。 然后， AppActivate "Some PDF.pdf"将激活一个带有以“ Some PDF.pdf” 开头的标题的窗口-或者，如果没有，则会引发错误。

Sub StartAdobe()
    Dim AdobeApp As String
    Dim AdobeFile As String
    Dim StartAdobe

    AdobeApp = "location of adobe reader"
    AdobeFile = "file location"

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

    DoEvents
    Application.Wait Now()+TimeSerial(0,0,10)
    DoEvents

    On Error GoTo NoFile

    AppActivate Dir(AdobeFile)
    SendKeys ("^a")
    SendKeys ("^c")

    DoEvents
    Application.Wait Now() + TimeSerial(0, 0, 2)
    DoEvents

    AppActivate Workbooks("testy").Application.Caption

    'ALWAYS qualify your Ranges!
    ActiveSheet.Range("A1").Paste 'No need to SendKeys here!

    Exit Sub
NoFile:
    If MsgBox(AdobeFile & " could not be identified", vbCritical + vbAbortRetryIgnore) = vbRetry Then Resume
End Sub