PDA

View Full Version : Word macro to copy files (.doc, .pdf)from hyperlinks in a document



gzombek
10-07-2010, 11:06 AM
We have a checklist doc that has hyperlinks to the files on the network. I trying to write a macro to take print all the files hyper linked to a PDF organizer program. I can make the word docs work the problem is the PDF files that are hyper linked open in word as well and you know what happen then.
:motz2:I find out later that the PDF program has a watch folder...so if I can copy all the hyperlinks (the files not the link address) to this folder the PDF program will do the rest.

Can anyone tell me the string to copy all files from all hyperlinks in a doc to c:\watchfolder


Here is the code I have for the working word files :
Sub PrintHyperlinks()

Set oWord = CreateObject("Word.Application")
oWord.WordBasic.FilePrintSetup Printer:="pdfDocs", _
DoNotSetAsSysDefault:=1
Dim h As Hyperlink
Dim d As Word.Document
If ActiveDocument.Hyperlinks.Count > 0 Then
Application.ScreenUpdating = False
For Each h In ActiveDocument.Hyperlinks
'Debug.Print h.Address
If Dir$(h.Address) <> "" Then
Set d = Application.Documents.Open(FileName:=h.Address, Visible:=False)
d.PrintOut Background:=True
d.Close Savechanges:=False
Set d = Nothing
End If
Next h
Application.ScreenUpdating = True
End If
ActiveDocument.PrintOut
End Sub

I tried and failed to make a if word do ....If PDf do ... with this code
The problem was getting the path set for adobe to print.
Sub PPDF()
Set oWord = CreateObject("Word.Application")
oWord.WordBasic.FilePrintSetup Printer:="pdfDocs", DoNotSetAsSysDefault:=1

Dim strPDFFileName As String
Dim h As Hyperlink
Dim s As String
Dim d As Word.Document
Dim sAdobeReader As String

For Each h In ActiveDocument.Hyperlinks
'Debug.Print h.Address

If Dir$(h.Address) <> "" Then

If Right(h.Address, 3) = "doc" Then
' Word
Set d = Application.Documents.Open(FileName:=h.Address, Visible:=False)
d.PrintOut Background:=True
d.Close Savechanges:=False
Set d = Nothing

ElseIf Right(h.Address, 3) = "pdf" Then

'PDF
Set sStrPDFFileName = h


sAdobeReader = "C:\Program Files\Adobe\Acrobat 6.0\Reader\AcroRd32.exe"

RetVal = Shell(sAdobeReader & "/P" & Chr(34) & sStrPDFFileName & Chr(34), 0)

Else
' Other
End If

End If
Next h

End Sub

Sorry I'm still learning this stuff :dunno