Loop through worksheet hyperlinks and save files in a different location

[richand1]

Hi,

I have some code which loops through a given folder and deposits filenames and their locations among other details into a table on a worksheet:

I have some code that then loops through the Hyperlinks in the "File Link" field/column and saves these files to a static location within the code:

Sub Upload_to_Sharepoint()

Dim hlink As Hyperlink
Dim wb As Workbook
Dim saveloc As String
Dim filen As String

'Timer
Dim StartTime As Double: StartTime = Timer
Dim MinutesElapsed As String    'Remember time when macro starts

Application.ScreenUpdating = False

saveloc = "[URL unfurl="true"]https://xxx.com/xxx/TEST/Shared[/URL] Documents/"
For Each hlink In ThisWorkbook.Sheets("FileDirectory").Range("J:J").Hyperlinks

    Set wb = Workbooks.Open(hlink.Address)
    wb.SaveAs saveloc & ActiveWorkbook.Name
    wb.Close True
    Set wb = Nothing
Next

Application.ScreenUpdating = True

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
txEnd = "Done. The code ran successfully in " & MinutesElapsed & "."

MsgBox txEnd

End Sub

I now need to upgrade this routine by, instead of using a hard-coded file destination, have a user enter a new destination for each file in the table into a new field/column and for the code to use that.

The table is named "Ref_FileList" and the hyperlinks reside with the field "File Links", the new destinations can reside within a field named "File Destination". I'm still new to working with structured tables in VBA so any help you can give with altering my code to work with this table would be highly appreciated.

Thanks very much,
Rich

 

[SkipVought]

Hi,

A picture of your sheet is pretty much, er, uh, pretty. Not worth much more. Fuzzy, but not warm.

But maybe some code like this...

Dim r As Range

For Each r In [Ref_FileList[File Links]]
    With Workbooks.Open(r.Address)
        .SaveAs Intersect(r.EntireRow, [Ref_FileList[File Destination]]).Value
        .Close
    End With
Next

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[richand1]

Thanks again, Skip. As long I've made someone feel fuzzy and warm, it's been a good day!

I'll try this tomorrow.

Rich

 

[SkipVought]

Great.

Please notice that I changed the SaveAs statement, adding the .Value property of this object.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[richand1]

Skip, the code you provided throws an error.

I get the following:

On line:

With Workbooks.Open(r.Address)

The cell reference in the error dialogue (if you'll consult the picture I provided you(!)) is the correct reference of where the first file location is stored. I'm guessing the error is because of the use of the range object before the address object because if I amend the code to the following I can at least get the file to open:

Sub Save_New_Code()

Dim r As Range
Dim hlink As Hyperlink

For Each hlink In [Ref_FileList[File Link]].Hyperlinks
    With Workbooks.Open(hlink.Address)
        .SaveAs Intersect(r.EntireRow, [Ref_FileList[File Destination]]).Value
        .Close
    End With
Next

End Sub

but this throws an "Object variable or With block variable not set" error on line:

.SaveAs Intersect(r.EntireRow, [Ref_FileList[File Destination]]).Value

I think this is because the focus is then passed to the newly opened workbook? Maybe?

Did I pass the test you clearly deliberately left me?

Thanks,
Rich

 

[SkipVought]

[tt]With Workbooks.Open(r.Hyperlinks.Address) [/tt]

You may have to play with this using the Watch Window.
FAQ707-4594

It may need to be [tt]r.Hyperlinks(1).Address[/tt]

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[richand1]

Thanks for that, Skip, although with the below code I can get the first file to open (I had to remove the table references as I couldn't get them to work):

For Each hlink In ThisWorkbook.Sheets("FileDirectory").Range("J:J").Hyperlinks
    With Workbooks.Open(hlink.Address)
        .SaveAs Intersect(r.EntireRow, ThisWorkbook.Sheets("FileDirectory").Range("K:K")).Value
        .Close
    End With
Next

But I get the Object Variable or With... error on line:

.SaveAs Intersect(r.EntireRow, ThisWorkbook.Sheets("FileDirectory").Range("J:J")).Value

Would this suggest that it's not in fact the Hyperlinks object that is causing the issue, rather it is the Save portion?

 

[SkipVought]

[tt]Intersect(r.EntireRow, ThisWorkbook.Sheets("FileDirectory").Range("J:J")).Value[/tt]

What this says is that the [tt]For Each r...Next[/tt] that r range is on sheet FileDirectory AND column J:J is on the same sheet and we’re getting the j value on the r row.

Is that indeed the intention?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[richand1]

Sorry! The reference for that line should be K:K, but yes, that is the intention.

J:J is where the file location is stored.

K:K is where the new save location is stored.

But they are all on the same sheet: "File Directory".

Thank you, Skip.

 

[SkipVought]

For clarity in your code you ought to use the Table Heading Value, rather that the nondescript K:K

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]