关闭PDF文件时出现PDF到Excel错误

时间:2017-08-23 18:54:33

标签: excel vba excel-vba pdf

我有一个代码将PDF文件传输到Excel,但我在其中一行中收到错误消息,我不知道原因。

我能够正确地从PDF中提取和粘贴数据,问题是在尝试关闭PDF文件时。

我正在使用的代码如下:

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
 (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
 ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub PDFExtract()

' Get name of Excel file
TemplateName = ThisWorkbook.Name

Dim oW As Worksheet: Set oW = ThisWorkbook.Worksheets("Temp")
FileToOpen = "c:\text.pdf"
ShellExecute 0, "Open", FileToOpen, "", "", vbNormalNoFocus
num = ShellExecute(0, "Open", FileToOpen, "", "", vbNormalNoFocus)

' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")

' select all using ctrl a
SendKeys "^a", True

' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")

' copy all using ctrl c
SendKeys "^c"

' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")

' activate this wokbook
Windows(TemplateName).Activate
Sheets("Temp").Select
Range("B7").Select
ActiveSheet.Paste

Call TerminateApp ' The problem in the code for TerminateApp
End sub

到目前为止一切顺利。现在我有问题的TerminateApp代码

Sub TerminateApp()

Dim strTerminateThis As String

Dim objWMIcimv2 As Object, objProcess As Object, objList As Object
Dim intError As Integer

strTerminateThis = "AcroRd32.exe"

Set objWMIcimv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='" & strTerminateThis & "'")
For Each objProcess In objList
    intError = objProcess.Terminate '<<< Here is where I get the error message
    If intError <> 0 Then Exit For
Next

'ALL instances of exe (strTerminateThis) have been terminated
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing

End Sub

我在上面突出显示了我收到错误消息的地方。我收到的错误消息是:运行时错误'-2147217406(80041002):未找到

我发现奇怪的是:

  • PDF文件已关闭
  • 如果我跨过该行,该程序 继续没有错误
  • 如果我打开另一个PDF文件,它会关闭 两者都没有给出错误信息

看起来它会关闭PDF文件,然后尝试查找但却找不到它。任何想法出现错误的原因以及如何解决问题?

我尝试根据http://jsfiddle.net/stevehn/ntjnnh4y/中的示例here修改代码,但它不起作用:

Do
    Set objWMIcimv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='" & strTerminateThis & "'")
    If objList.Count > 0 Then
        For Each objProcess In objList
            intError = objProcess.Terminate 'Terminates a process and all of its threads.
            'Return value is 0 for success. Any other number is an error.
            If intError <> 0 Then Exit For
        Next
    End If
Loop While objList.Count > 0

1 个答案:

答案 0 :(得分:1)

Function ShellExecute下,添加以下两项:

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
        (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
        (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

然后是TerminateApp代码:

Dim hWnd As Long
Dim nRet As Long

Const WM_CLOSE As Long = &H10

hWnd = FindWindow("AcrobatSDIWindow", vbNullString)

If hWnd <> 0 Then
    nRet = SendMessage(hWnd, WM_CLOSE, 0, 0)
End If

请尝试告诉我这是否有效。

P.S。我只测试了一个PDF打开和关闭。