Change Macro to import files from hyperlinks

[GarnesGambit]

Hi all,

I'm new to Macros and learning as I go! I have a great Macro (I found online) that allows me to select a folder and it will import all excel files in this folder and consolidate into one worksheet.

I'm wondering, would it be possible to edit this macro to instead of take files from a folder on my desktop, I can select multiple hyperlinks in my workbook and open/ consolidate those? Example I could select multiple cells in column J of my workbook (this column contains the individual files) and run this code to consolidate?

Essentially I have a master file, where each of my files are hyperlinked and linked to specific stores (some plans are unique, others can belong to multiple stores). The struggle I have is all plans are in 1 folder just now as it's not sustainable to have to save them multiple times in multiple folders by store.

Code below:

Sub ImportFiles()
Dim strPath As String, xStrPath As String, xStrName As String, xStrFName As String
Dim xWS As Worksheet, xTWB As Workbook, DestSheet As Worksheet, FileName As String
Dim xStrAWBName As String, Sh1 As Worksheet, FolderName As String, sItem As String
Dim FolderPath As String, fldr As FileDialog, Lr As Long, Lc As Long, Lr2 As Long
On Error Resume Next
Set xTWB = ThisWorkbook
Set DestSheet = xTWB.ActiveSheet
Debug.Print DestSheet.Name
  Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    FolderName = sItem
    Set fldr = Nothing
    FolderPath = FolderName & "\"
   FileName = Dir(FolderPath & "*.xls*")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
Set Sh1 = ActiveWorkbook.Sheets("Sheet1")
xStrName = Sh1.Name
For Each xWS In ActiveWorkbook.Sheets
If xWS.Name = xStrName Then
Lr = DestSheet.Range("C" & Rows.Count).End(xlUp).Row
Lr2 = xWS.Range("C" & Rows.Count).End(xlUp).Row
Lc = Cells(1, Columns.Count).End(xlToLeft).Column
If Lr = 1 Then
Range(xWS.Cells(1, 1), xWS.Cells(Lr2, Lc)).Copy DestSheet.Range("C1")
Else
Range(xWS.Cells(2, 1), xWS.Cells(Lr2, Lc)).Copy DestSheet.Range("C" & Lr + 1)
End If
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
xTWB.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

Appreciate all help in advance!

 

[GarnesGambit]

Apologies John- your code works wonderfully! I was selecting the wrong hyperlinks (my pdfs not Excel files, which is why nothing was copying!)

Just out of curiosity, what would I amend to this code to have it run from the workbook containing the hyperlinks?

I actually only have the 2 workbooks, I think my above message was confusing. I have the master workbook containing the hyperlinks, and the consolidation workbook. Not an issue though has I can amend how I work with them.

Thanks again for taking the time to teach me! I will mark this as resolved, but if you have the time would love info on the the above question.

 

[John_w]

For an update John, I added the code

Private Sub Workbook_Open()
ActiveWorkbook.EnableConnections
Application.DisplayAlerts = False
End Sub

Which removes the DDE message, but still no data transfers into the consolidated workbook.

Glad you got it sorted, however that code turns off alerts for the whole Excel session, so it won't display warnings such as 'File already exists, do you want to overwrite it', etc.

It's better to turn off/on alerts only when needed, usually around Workbooks.Open or Save lines:

                Application.DisplayAlerts = False
                Set Wb = Workbooks.Open(linkAddress, UpdateLinks:=False, ReadOnly:=True)
                Application.DisplayAlerts = True

For the DDE message I was going to suggest adding UpdateLinks:=False to the Workbooks.Open call, as shown above, and add ActiveWorkbook.EnableConnections at the top of my macro.

Just out of curiosity, what would I amend to this code to have it run from the workbook containing the hyperlinks?

Replace:

    Set HyperlinksWb = Workbooks.Open("C:\folder\path\HYPERLINKS WORKBOOK.xlsx")

with:

    Set HyperlinksWb = ThisWorkbook

and delete this line if you want to keep the hyperlinks (macro) workbook open at the end.

    HyperlinksWb.Close False

 

[GarnesGambit]

Fantastic advice, John. The code works perfectly- just what I needed. Feel like I'm understanding the code more as I use it. Thanks again!!