VBA代码中SendKeys "^c"失效，求批量PDF转Excel解决方案

原代码依赖SendKeys执行复制操作，但SendKeys本身稳定性极差——它完全依赖窗口焦点、系统响应速度，等待时间设置不合理也会导致操作失效。以下是两种修复方案：

方案1：优化SendKeys流程（临时应急） #

如果暂时不想引入外部库，可以优化窗口激活和等待逻辑，确保Chrome窗口获得焦点后再执行复制：

Sub CopyAllPDFsFromFolderToExcel_ImprovedSendKeys()
    Dim folderPath As String
    Dim pdfFile As String
    Dim pdfFiles As Collection
    Dim i As Integer
    Dim chromeWindowTitle As String
    
    folderPath = "C:\Users\Desktop\Testtt\"
    
    Set pdfFiles = New Collection
    
    pdfFile = Dir(folderPath & "*.pdf")
    Do While pdfFile <> ""
        pdfFiles.Add folderPath & pdfFile
        pdfFile = Dir
    Loop

    For i = 1 To pdfFiles.Count
        ' 打开PDF，获取窗口标题（Chrome打开PDF的标题是文件名）
        Shell "C:\Users\Local\Google\Chrome\Application\chrome.exe --new-window """ & pdfFiles(i) & """", vbNormalFocus
        chromeWindowTitle = Mid(pdfFiles(i), InStrRev(pdfFiles(i), "\") + 1)
        
        ' 等待Chrome窗口加载并激活，循环确认直到激活成功
        Do
            On Error Resume Next
            AppActivate chromeWindowTitle
            On Error GoTo 0
            Application.Wait Now + TimeValue("00:00:01")
        Loop Until Err.Number = 0
        
        ' 全选+复制，增加等待时间确保操作完成
        SendKeys "^a", True
        Application.Wait Now + TimeValue("00:00:02")
        SendKeys "^c", True
        Application.Wait Now + TimeValue("00:00:02")
        
        ' 切回Excel
        AppActivate ThisWorkbook.Caption
        
        ' 定位到下一行起始位置
        With ThisWorkbook.Worksheets(1)
            Dim lastRow As Long
            lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
            .Cells(lastRow, "A").Select
            .PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
        End With
        
        ' 关闭Chrome窗口（避免窗口过多）
        SendKeys "%{F4}", True
    Next i

    MsgBox "All PDFs copied!"
End Sub

优化点： #

• 循环确认Chrome窗口激活，避免焦点丢失
• 用文件名精准激活Chrome窗口，而非模糊的AppActivate
• 操作后关闭Chrome窗口，减少系统资源占用
• 更精准的行定位，替代原代码中不稳定的SpecialCells(xlLastCell)

方案2：使用Adobe Acrobat COM对象（稳定可靠） #

SendKeys本质是模拟人工操作，始终存在不稳定问题。最可靠的方式是直接读取PDF内容，无需打开浏览器：

注意：需要安装Adobe Acrobat（不是Reader），并在VBA编辑器中引用Adobe Acrobat xx.x Type Library（工具→引用）

Sub CopyAllPDFsFromFolderToExcel_AcrobatAPI()
    Dim folderPath As String
    Dim pdfFile As String
    Dim pdfFiles As Collection
    Dim i As Integer
    Dim acroApp As Acrobat.AcroApp
    Dim acroAVDoc As Acrobat.AcroAVDoc
    Dim acroPDDoc As Acrobat.AcroPDDoc
    Dim pageNum As Integer
    Dim pdfText As String
    
    folderPath = "C:\Users\Desktop\Testtt\"
    
    Set pdfFiles = New Collection
    pdfFile = Dir(folderPath & "*.pdf")
    Do While pdfFile <> ""
        pdfFiles.Add folderPath & pdfFile
        pdfFile = Dir
    Loop

    ' 初始化Acrobat对象
    Set acroApp = CreateObject("AcroExch.App")
    Set acroAVDoc = CreateObject("AcroExch.AVDoc")
    
    For i = 1 To pdfFiles.Count
        If acroAVDoc.Open(pdfFiles(i), "") Then
            Set acroPDDoc = acroAVDoc.GetPDDoc()
            pdfText = ""
            
            ' 读取所有页面内容
            For pageNum = 0 To acroPDDoc.GetNumPages() - 1
                Dim acroPage As Acrobat.AcroPDPage
                Dim acroTextSelect As Acrobat.AcroPDTextSelect
                Dim j As Integer
                
                Set acroPage = acroPDDoc.AcquirePage(pageNum)
                Set acroTextSelect = acroPage.CreatePageTextSelect(0, 0, 0, 0)
                
                For j = 0 To acroTextSelect.GetNumText() - 1
                    pdfText = pdfText & acroTextSelect.GetText(j) & vbCrLf
                Next j
            Next pageNum
            
            ' 将文本写入Excel
            With ThisWorkbook.Worksheets(1)
                Dim lastRow As Long
                lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
                .Cells(lastRow, "A").Value = pdfText
            End With
            
            ' 关闭当前PDF
            acroAVDoc.Close True
        End If
    Next i
    
    ' 清理对象
    acroApp.Exit
    Set acroTextSelect = Nothing
    Set acroPage = Nothing
    Set acroPDDoc = Nothing
    Set acroAVDoc = Nothing
    Set acroApp = Nothing

    MsgBox "All PDFs copied!"
End Sub

优势： #

• 无需打开浏览器或模拟人工操作，完全后台读取
• 内容提取更精准，不会因格式问题丢失文本
• 稳定性远高于SendKeys方案

内容的提问来源于stack exchange，提问作者Aaron Enriquez