Copy hyperlink content (.pdf) to a destination folder

[McQuinge]

Hi!

I have a sheet with several hyperlinked documents. With using a filter function I can get a list of documents that I want to print out.

So I need a macro to look at each hyperlink and find the filepath and name, copy the file to a destination folder like C:\test\
There is something with FileCopy but I dont know how to built it up in VB.

I have tried earlier to do a direct print of the hyperlink content, searched and started a thread, but I dont get any respons.

Please Help!

 

[Jon von der Heyden]

I forgot about that bit, try:

[COLOR="Blue"]Public[/COLOR] [COLOR="Blue"]Sub[/COLOR] CopyFile()
    [COLOR="Blue"]Dim[/COLOR] objFSO [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Object[/COLOR]
    [COLOR="Blue"]Dim[/COLOR] objFil [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Object[/COLOR]
    [COLOR="Blue"]Dim[/COLOR] rngCell [COLOR="Blue"]As[/COLOR] Range
    [COLOR="Blue"]Dim[/COLOR] strOldDir [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]String[/COLOR]
    [COLOR="Blue"]Const[/COLOR] strNewDir [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]String[/COLOR] = "C:\"
    
    strOldDir = ThisWorkbook.Path & "\"
    
    [COLOR="Blue"]Set[/COLOR] objFSO = [COLOR="Blue"]CreateObject[/COLOR]("Scripting.FileSystemObject")
    
    [COLOR="Blue"]On[/COLOR] [COLOR="Blue"]Error[/COLOR] [COLOR="Blue"]Resume[/COLOR] [COLOR="Blue"]Next[/COLOR]
        [COLOR="Blue"]For[/COLOR] [COLOR="Blue"]Each[/COLOR] rngCell [COLOR="Blue"]In[/COLOR] Selection.SpecialCells(12)
            [COLOR="Blue"]Set[/COLOR] objFil = objFSO.GetFile(strOldDir & rngCell.Hyperlinks(1).Address)
            objFil.Copy strNewDir
        [COLOR="Blue"]Next[/COLOR] rngCell
    [COLOR="Blue"]On[/COLOR] [COLOR="Blue"]Error[/COLOR] [COLOR="Blue"]GoTo[/COLOR] 0
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]

 

[McQuinge]

Thank you!!!

You have fixed my biggest challenge on work for the last week.
This will save us many operations.

I haven't got time to test it on work yet, but I will post a new message tommorrow with the results!

Thanks again!

 

[McQuinge]

Okey!

Now I have tested it, and it works when I have all the files on the computer.
But the Live version of my sheet and documents is on a sharepoint site, and when I run the macro there, nothing happens. No errors! No files!

Is this easy to fix, if not I manage to take a backup from sharepoint to my computer and work offline.

Thanks!

 

[Jon von der Heyden]

I'm afraid I haven't tried to do this on sharepoint DL's before so I don't actually know off hand what method to use.

 

[McQuinge]

I'm trying a different solution. I have changed all my hyperlinks to the hyperlink function. How can the macro find the information in the hyperlink function?

 

[Jon von der Heyden]

This way works for me, again using file directory not Sharepoint DL:

[COLOR="Blue"]Public[/COLOR] [COLOR="Blue"]Sub[/COLOR] CopyFile()
    [COLOR="Blue"]Dim[/COLOR] objFSO [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]Object[/COLOR]
    [COLOR="Blue"]Dim[/COLOR] rngCell [COLOR="Blue"]As[/COLOR] Range
    [COLOR="Blue"]Dim[/COLOR] strHyp [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]String[/COLOR]
    [COLOR="Blue"]Const[/COLOR] strNewDir [COLOR="Blue"]As[/COLOR] [COLOR="Blue"]String[/COLOR] = "C:\Excel\"
    
    [COLOR="Blue"]Set[/COLOR] objFSO = [COLOR="Blue"]CreateObject[/COLOR]("Scripting.FileSystemObject")
    
    [COLOR="Blue"]For[/COLOR] [COLOR="Blue"]Each[/COLOR] rngCell [COLOR="Blue"]In[/COLOR] Selection.SpecialCells(12)
        [COLOR="Blue"]With[/COLOR] rngCell
            [COLOR="Blue"]If[/COLOR] [COLOR="Blue"]Left$[/COLOR](.Formula, 11) = "=HYPERLINK(" [COLOR="Blue"]Then[/COLOR]
                [COLOR="Blue"]If[/COLOR] [COLOR="Blue"]InStr[/COLOR](.Formula, ",") > 0 [COLOR="Blue"]Then[/COLOR]
                    strHyp = [COLOR="Blue"]Mid$[/COLOR](.Formula, 13, [COLOR="Blue"]InStr[/COLOR](.Formula, ",") - 14)
                [COLOR="Blue"]Else[/COLOR]
                    strHyp = [COLOR="Blue"]Mid$[/COLOR](.Formula, 13, [COLOR="Blue"]Len[/COLOR](.Formula) - 14)
                [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]If[/COLOR]
            [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]If[/COLOR]
        [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]With[/COLOR]
        [COLOR="Blue"]If[/COLOR] [COLOR="Blue"]Len[/COLOR](strHyp) > 0 [COLOR="Blue"]Then[/COLOR]
            [COLOR="Blue"]If[/COLOR] [COLOR="Blue"]Len[/COLOR]([COLOR="Blue"]Dir[/COLOR](strHyp)) > 0 [COLOR="Blue"]Then[/COLOR]
                objFSO.GetFile(strHyp).Copy strNewDir
            [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]If[/COLOR]
        [COLOR="Blue"]End[/COLOR] [COLOR="Blue"]If[/COLOR]
        strHyp = ""
    [COLOR="Blue"]Next[/COLOR] rngCell
[COLOR="Blue"]End[/COLOR] [COLOR="Blue"]Sub[/COLOR]