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