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

有谁知道我做错了什么？在secondub之前，一切都运作良好。

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窗口将具有标题＆＃34;一些PDF.pdf - Adob​​e Reader＆＃34;或者＆＃34;一些PDF.pdf - Adob​​e Acrobat＆＃34;和Dir(AdobeFile)将是＆＃34;一些PDF.pdf＆＃34;。然后，AppActivate "Some PDF.pdf"将激活一个标题为启动的窗口，其中包含＆＃34;某些PDF.pdf＆＃34; - 或者，如果没有错误则抛出错误。

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