[英]Open PDF file and copy filepath and print pages VBA
我目前有一个循环遍历列表并根据关键字查找 PDF 文件的宏。 宏可以正常工作,但我想更进一步。 宏根据每个项目的报告编号搜索正确的 PDF。
我想循环和:
超链接“M”列中的文件。
检查文件是否正确打开并将状态放在“K”列中
最小化所有打开的 PDF 窗口。
如果可能,请在 PDF 中找到项目编号及其对应的页面。 每页也标有项目编号,因此也可以通过这种方式进行搜索。 我想以某种方式打印正确的页面。
有数百份报告,这是一个非常乏味的过程。 我也有 Adobe Pro。 我愿意接受所有建议。
基于通配符查找 PDF 的当前工作代码:
`Sub Open_PDF()
Dim filePath As String, fileName As String, iName As String
Dim lrow As Long
Dim i As Long
lrow = Cells(Rows.Count, 10).End(xlUp).Row
For i = 5 To lrow
iName = Cells(i, 10)
FileType = Range("FileType")
filePath = Range("B6")
fileName = Dir(filePath & iName & "*" & "." & FileType)
If fileName <> "" Then
openAnyFile filePath & fileName
End If
Next i
End Sub
Function openAnyFile(strPath As String)
Dim objShell As Object
Set objShell = CreateObject("Shell.Application")
objShell.Open (strPath)
End Function
`
我找到了以下代码,但无法理解如何使其工作。
Option Explicit
'Retrieves a handle to the top-level window whose class name and window name match the
specified strings.
'This function does not search child windows. This function does not perform a case-
sensitive search.
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
`'Retrieves a handle to a window whose class name and window name match the specified
strings.
'The function searches child windows, beginning with the one following the specified
child window.
'This function does not perform a case-sensitive search.
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
'Brings the thread that created the specified window into the foreground and activates
the window.
'Keyboard input is directed to the window, and various visual cues are changed for the
user.
'The system assigns a slightly higher priority to the thread that created the
foreground
'window than it does to other threads.
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
'Sends the specified message to a window or windows. The SendMessage function calls
the window procedure
'for the specified window and does not lParenturn until the window procedure has
processed the message.
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
'Places (posts) a message in the message queue associated with the thread that created
the specified
'window and lParenturns without waiting for the thread to process the message.
Public Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
As Long
'Constants used in API functions.
Public Const WM_SETTEXT = &HC
Public Const VK_RETURN = &HD
Public Const WM_KEYDOWN = &H100
Private Sub OpenPDF(strPDFPath As String, strPageNumber As String, strZoomValue As String)
'Opens a PDF file to a specific page and with a specific zoom
'using Adobe Reader Or Adobe Professional.
'API functions are used to specify the necessary windows
'and send the page and zoom info to the Adobe window.
'By Christos Samaras
'https://myengineeringworld.net/////
Dim strPDFName As String
Dim lParent As Long
Dim lFirstChildWindow As Long
Dim lSecondChildFirstWindow As Long
Dim lSecondChildSecondWindow As Long
Dim dtStartTime As Date
'Check if the PDF path is correct.
If FileExists(strPDFPath) = False Then
MsgBox "The PDF path is incorect!", vbCritical, "Wrong path"
Exit Sub
End If
'Get the PDF file name from the full path.
On Error Resume Next
strPDFName = Mid(strPDFPath, InStrRev(strPDFPath, "") + 1, Len(strPDFPath))
On Error GoTo 0
'The following line depends on the apllication you are using.
'For Word:
'ThisDocument.FollowHyperlink strPDFPath, NewWindow:=True
'For Power Point:
'ActivePresentation.FollowHyperlink strPDFPath, NewWindow:=True
'Note that both Word & Power Point pop up a security window asking
'for access to the specified PDf file.
'For Access:
'Application.FollowHyperlink strPDFPath, NewWindow:=True
'For Excel:
ThisWorkbook.FollowHyperlink strPDFPath, NewWindow:=True
'Find the handle of the main/parent window.
dtStartTime = Now()
Do Until Now() > dtStartTime + TimeValue("00:00:05")
lParent = 0
DoEvents
'For Adobe Reader.
'lParent = FindWindow("AcrobatSDIWindow", strPDFName & " - Adobe Reader")
'For Adobe Professional.
lParent = FindWindow("AcrobatSDIWindow", strPDFName & " - Adobe Acrobat Pro")
If lParent <> 0 Then Exit Do
Loop
If lParent <> 0 Then
'Bring parent window to the foreground (above other windows).
SetForegroundWindow (lParent)
'Find the handle of the first child window.
dtStartTime = Now()
Do Until Now() > dtStartTime + TimeValue("00:00:05")
lFirstChildWindow = 0
DoEvents
lFirstChildWindow = FindWindowEx(lParent, ByVal 0&, vbNullString, "AVUICommandWidget")
If lFirstChildWindow <> 0 Then Exit Do
Loop
'Find the handles of the two subsequent windows.
If lFirstChildWindow <> 0 Then
dtStartTime = Now()
Do Until Now() > dtStartTime + TimeValue("00:00:05")
lSecondChildFirstWindow = 0
DoEvents
lSecondChildFirstWindow = FindWindowEx(lFirstChildWindow, ByVal 0&, "Edit", vbNullString)
If lSecondChildFirstWindow <> 0 Then Exit Do
Loop
If lSecondChildFirstWindow <> 0 Then
'Send the zoom value to the corresponding window.
SendMessage lSecondChildFirstWindow, WM_SETTEXT, 0&, ByVal strZoomValue
PostMessage lSecondChildFirstWindow, WM_KEYDOWN, VK_RETURN, 0
dtStartTime = Now()
Do Until Now() > dtStartTime + TimeValue("00:00:05")
lSecondChildSecondWindow = 0
DoEvents
'Notice the difference in syntax between lSecondChildSecondWindow and lSecondChildFirstWindow.
'lSecondChildSecondWindow is the handle of the next child window after lSecondChildFirstWindow,
'while both windows have as parent window the lFirstChildWindow.
lSecondChildSecondWindow = FindWindowEx(lFirstChildWindow, lSecondChildFirstWindow, "Edit", vbNullString)
If lSecondChildSecondWindow <> 0 Then Exit Do
Loop
If lSecondChildSecondWindow <> 0 Then
'Send the page number to the corresponding window.
SendMessage lSecondChildSecondWindow, WM_SETTEXT, 0&, ByVal strPageNumber
PostMessage lSecondChildSecondWindow, WM_KEYDOWN, VK_RETURN, 0
End If
End If
End If
End If
End Sub
Function FileExists(strFilePath As String) As Boolean
'Checks if a file exists.
'By Christos Samaras
'https://myengineeringworld.net/////
On Error Resume Next
If Not Dir(strFilePath, vbDirectory) = vbNullString Then FileExists = True
On Error GoTo 0
End Function
Sub TestPDF()
OpenPDF ThisWorkbook.Path & "" & "Sample File.pdf", 6, 143
End Sub
我可以部分帮助您:
Sub Open_PDF()
Dim filePath As String, fileName As String, iName, disptxt As String
Dim lrow As Long
Dim i As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
lrow = Cells(Rows.Count, 10).End(xlUp).Row
For i = 5 To lrow
iName = Cells(i, 10)
FileType = Range("FileType")
filePath = Range("B6")
fileName = Dir(filePath & iName & "*" & "." & FileType)
If fileName <> "" Then
disptxt = filePath & iName ' whatever you want the hyperlink to show
ws.Hyperlinks.Add Anchor:=ws.Range("M" & i), Address:=filePath & fileName, ScreenTip:="hover message", TextToDisplay:=disptxt
Range("K" & i) = "Success"
openAnyFile filePath & fileName
Else
Range("K" & i) = "Failed"
End If
Next i
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.