0

I have a list of pdf hyperlinks in excel and am trying to create a macro to go down the list of hyperlinks and open them to test if they work. The list is on sheet4.rowD. The following code is what I've tried but keeps throwing error 400.

Sub Test_Template_Links()

With Sheet4
LastRow = Sheet4.Range("D999").End(xlUp).Row
For CustRow = 2 To 3 'LastRow

ThisWorkbook.FollowHyperlink Sheet4.Range("E" & CustRow).Value

Application.Wait 0.00002
Application.SendKeys "^(q)", True
Application.Wait 0.00001

Next CustRow

End With

End Sub

Also, if anyone knows a way to highlight the cell if it doesn't work and keep the macro continuing that would be awesome but not necessary right now.

JoshL
  • 164
  • 1
  • 12

1 Answers1

1

This should do what you are looking for. You will need to place the PDFs in a trusted location otherwise you will get a popup every time it tries to open one. There may be a workaround besides trusted locations but I am not aware of it (and is generally ill-advised to use such things).

You will also need to change Hwnd = FindWindow(vbNullString, filename & " - Foxit Reader") to whatever PDF reader you are using, I have Foxit so that's what it is currently.

Thanks to Siddharth Rout for the closing of the PDF.

Option Explicit
'Thanks to Siddharth Rout for this chunk

#If VBA7 Then
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long
    
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassname As String, ByVal lpWindowName As String) As Long
#Else
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
    lParam As Any) As Long
    
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassname As String, ByVal lpWindowName As String) As Long
#End If

Private Const WM_CLOSE = &H10

Sub t()
    Dim Tcell As Range
    Dim link As String
    Dim lastrow As Long
    Dim iter As Long
    With Sheet4
        lastrow = .Cells(.Rows.Count, 5).End(xlUp).Row
        For iter = 2 To lastrow
            Set Tcell = .Cells(iter, 5)
            On Error GoTo errhandler
            ThisWorkbook.FollowHyperlink Tcell.value
            On Error GoTo 0
            'Thanks to Siddharth Rout for this chunk
            Dim Hwnd As Long
            Dim filename As String
            filename = Split(Tcell.value, "\")(UBound(Split(Tcell.value, "\")))
            '~~> Find the window of the pdf file
            Hwnd = FindWindow(vbNullString, filename & " - Foxit Reader")
            '~~> Close the file
            PostMessage Hwnd, WM_CLOSE, 0, ByVal 0&
continueiter:
        Next iter
    End With
    Exit Sub
errhandler:
    Select Case Err.Number
        Case -2147221014
            Tcell.Interior.Color = vbRed
            GoTo continueiter
        Case Else
            MsgBox "Unhandled Error: " & Err.Number & chr(10) & Err.Description
    End Select
End Sub
Warcupine
  • 4,460
  • 3
  • 15
  • 24
  • When I try to type in the first chunk up top before Sub t(), everything is red and I can't figure out why – JoshL Jul 01 '20 at 15:38
  • Did you copy paste or type it out? Maybe you used a double (") quote instead instead of a single(') in the comment line? – Warcupine Jul 01 '20 at 15:44
  • I tried copy/paste and that didn't work so I typed it out and it still shows up as red errors. Just the two 'Private Declare....' lines It says "The code in this project must be updated for use on the 64-bit systems. Please review and update Declare statements and then mark them with the PtrSafe attribute." – JoshL Jul 01 '20 at 15:47
  • Okay, try that now. – Warcupine Jul 01 '20 at 15:52
  • Now I am getting a subscript out of range on `link = Split(Tcell.Formula, Chr(34))(1)` – JoshL Jul 01 '20 at 16:20
  • Does it have a proper hyperlink in the cell? – Warcupine Jul 01 '20 at 16:25
  • The hyperlink works with other calls (S:\Desktop\Test\Dog.pdf as an example). So it is definitely a proper hyperlink – JoshL Jul 01 '20 at 16:29
  • Are there no quotes in the link? – Warcupine Jul 01 '20 at 17:05
  • No, there are no quotes in the link. There are parentheses though – JoshL Jul 01 '20 at 17:55
  • That works as a hyperlink in ```=Hyperlink()```? weird, either way you'll need to change the delimiter from ```Chr(34)``` to ```(``` take index 1 then split the result on ```,``` and take index 0. So ```split(Split(Tcell.Formula, "(")(1), ",")(0)``` – Warcupine Jul 01 '20 at 17:59
  • Would this work with the hyperlink.. `S:\Desktop\(ref) Templates\Sample.pdf`.. I still seem to get the subscript out of range. – JoshL Jul 01 '20 at 18:31
  • Are they actually hyperlinks or are they text that has a path and a filename? – Warcupine Jul 01 '20 at 18:37
  • oh there are just text for the path and file name – JoshL Jul 01 '20 at 18:37
  • Well, that changes things, then you just need to use ```tcell.value``` wherever ```link``` is in the code. You will still need to split here: ```filename = Split(link, "\")(UBound(Split(link, "\")))``` but change link to tcell.value – Warcupine Jul 01 '20 at 18:39
  • Alright, thank you for the help. Its throwing an error still when I try to `ThisWorkbook.FollowHyperlink Tcell.Value` but I can hopefully figure this out without taking up more of your time here – JoshL Jul 01 '20 at 18:48