Save hyperlinked file to a cell

juangfd · Aug 31, 2011

I try to briefly explain my situation. I have a table where on a certain colum there are hyperlink to various type of file (mostly pdf). I am seeking for a way to save file of certain selected cells, faster than opening each file by clicking on the relative cell with hyperlink, and saving each file to the designated folder, which could be on the desktop on in any directory.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com

ffice

ffice" /><o

></o

>
<o

>Thanks,</o

>
<o

></o

>
<o

>juangfd</o

>

Case_Germany · Aug 31, 2011

Hi and welcome,

please give an example of how a link looks like. The files are linked on the Internet or on a hard drive? And by what criterion the target folders are picked out?

niceguy_jay · Aug 31, 2011

and where are the hyperlinked files ??
are they online or in some server or to another local drive ????

juangfd · Sep 1, 2011

Thanks for your interest. All the hyperlinked file are on a directory in the same computer. I use the table to archive drawings (most of them are pdf, but some are in editable format, that’s why in my table I have more than 1 column with hyperlink). Let’s say that I have to do a quick CD with some of the file of the table, my goal is to open the excel table, select only the cells with hyperlink of the file I want to safe and by pressing a command bottom (module, is that correct?) save all in the new CD, USB, DVD or on a temporary folder in the desktop.

Thanks again,

juangfd

Case_Germany · Sep 1, 2011

Hi,

the files to copy are in my example in "C:\Temp\". The folder "Burn" on the desktop is automatically created. "Sheet1" is the code name of the worksheet and may need to be adjusted. The cells with the hyperlinks mark then run the macro:

Code:

Option Explicit
Private Declare Function MakeSureDirectoryPathExists _
    Lib "imagehlp.dll" (ByVal Pfad As String) As Long
' The folder with the files
Const strPath As String = "C:\Temp\" ' adapt
Sub Main()
    On Error GoTo Fin
    Dim rngRange As Range
    With Sheet1 ' adapt
        MakeSureDirectoryPathExists _
            Environ("UserProfile") & "\Desktop\" & "Burn\"
        For Each rngRange In Selection
            If rngRange.Hyperlinks.Count > 0 Then
                FileCopy rngRange.Hyperlinks.Item(1).Address, _
                    Environ("UserProfile") & "\Desktop\" & _
                    "Burn\" & Dir(rngRange.Hyperlinks.Item(1).Address)
            End If
        Next rngRange
    End With
Fin:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub

juangfd · Sep 1, 2011

Let me be more precise:
the file (to be saved) linked in excel are not all in the same directory. The information of where they are is in the cells with hyperlink. I thought, that by selecting the cell the macro or the command can understand where are the files.

Thanks again

Case_Germany · Sep 1, 2011

Hi,

Yes - my mistake. You can delete these two lines:

Code:

' The folder with the files
Const strPath As String = "C:\Temp\" ' adapt

The code copied from the correct path:

Code:

Option Explicit
Private Declare Function MakeSureDirectoryPathExists _
    Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Sub Main()
    On Error GoTo Fin
    Dim rngRange As Range
    With Sheet1 ' adapt
        MakeSureDirectoryPathExists _
            Environ("UserProfile") & "\Desktop\" & "Burn\"
        For Each rngRange In Selection
            If rngRange.Hyperlinks.Count > 0 Then
                FileCopy rngRange.Hyperlinks.Item(1).Address, _
                    Environ("UserProfile") & "\Desktop\" & _
                    "Burn\" & Dir(rngRange.Hyperlinks.Item(1).Address)
            End If
        Next rngRange
    End With
Fin:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub

juangfd · Sep 1, 2011

Thanks again. Everything works well, but only with cells that have hyperlink manually inserted. For those cells that have hypelink with formula +hyperlink(...) this macro doesn't work. Most of my link are with formula. Any sugestion?

Thanks

Case_Germany · Sep 1, 2011

Hi,

juangfd said:
Any sugestion?

Yes:

Code:

Option Explicit
Private Declare Function MakeSureDirectoryPathExists _
    Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Sub Main()
    On Error GoTo Fin
    Dim rngRange As Range
    With Sheet1 ' adapt
        MakeSureDirectoryPathExists _
            Environ("UserProfile") & "\Desktop\" & "Burn\"
        For Each rngRange In Selection
            If rngRange.Hyperlinks.Count > 0 Then
                FileCopy rngRange.Hyperlinks.Item(1).Address, _
                    Environ("UserProfile") & "\Desktop\" & _
                    "Burn\" & Dir(rngRange.Hyperlinks.Item(1).Address)
            ElseIf rngRange.Formula Like "=HYPER*" Then
                FileCopy Split(rngRange.Formula, """")(1), _
                    Environ("UserProfile") & "\Desktop\" & _
                    "Burn\" & Dir(Split(rngRange.Formula, """")(1))
            End If
        Next rngRange
    End With
Fin:
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub

juangfd · Sep 2, 2011

I have tried the new code, but still doesn't work with hyperlink with formula. Could it be that I am using an Italian excel? The hyperlink formula is =COLLEG.IPERTESTUALE(...a...;...b...) and ...a... gets value in more than one cell in the same worksheet. In the code you provide me I have substituted “Sheet1” with “Foglio5” (and this is ok) and “=HYPERL*” with "=COLLEG.IPERTEST*".

These is how I have changed the code in to:

Option Explicit
Private Declare Function MakeSureDirectoryPathExists _
Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Sub Main()
On Error GoTo Fin
Dim rngRange As Range
With Foglio5 ' adapt
MakeSureDirectoryPathExists _
Environ("UserProfile") & "\Desktop\" & "Pippo\"
For Each rngRange In Selection
If rngRange.Hyperlinks.Count > 0 Then
FileCopy rngRange.Hyperlinks.Item(1).Address, _
Environ("UserProfile") & "\Desktop\" & _
"Pippo\" & Dir(rngRange.Hyperlinks.Item(1).Address)
ElseIf rngRange.Formula Like "=COLLEG.IPERTEST*" Then
FileCopy Split(rngRange.Formula, """")(1), _
Environ("UserProfile") & "\Desktop\" & _
"Pippo\" & Dir(Split(rngRange.Formula, """")(1))
End If
Next rngRange
End With
Fin:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub

There are other thinks that have to be changed?

Thanks again

Save hyperlinked file to a cell

juangfd

New Member

Excel Facts

Case_Germany

Active Member

niceguy_jay

Board Regular

juangfd

New Member

Case_Germany

Active Member

juangfd

New Member

Case_Germany

Active Member

juangfd

New Member

Case_Germany

Active Member

juangfd

New Member

Similar threads

Forum statistics

Share this page

Save hyperlinked file to a cell

New Member

Excel Facts

Active Member

Board Regular

New Member

Active Member

New Member

Active Member

New Member

Active Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock