VBA，AppActivate Microsoft excel

Question

我正在尝试使用发送键将我的pdf复制到excel中。然而，我在我的SecondStep sub中得到了一个编译错误

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

有人知道我做错了什么吗？在第二次替换之前，一切都运行得很好。

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窗口将有标题“一些PDF.pdf - Adobe Reader”或“一些PDF.pdf - Adobe Acrobat"，而Dir(AdobeFile)将是”一些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