I have been tasked with moving files/folders from legacy (G:Drive) to SharePoint. A lot of excel files contain links to other excel files. Is there any way I can create a list of which files contain links within a folder? Rather than going into each file individually? Can a file be recognised as containing links without opening?
-
If you would like to post, please check out the MrExcel Message Board FAQ and register here. If you forgot your password, you can reset your password.
List files from a folder that contain links to other files
- Thread starter fudgel
- Start date
This code will create a worksheet of the workbooks containing links to other workbooks and a worksheet detailing all of these links.
It will look in .xls, .xlsx and .xlsm files.
Put this code into a standard code module in a workbook not in the speciied folder.
It will ask you to save any other workbooks that are open.
It wil not make changes to any files that it opens.
All you need to do is to change this line to include your folder name.
strFolder = "C:\Private\Training\Excel\Find Cells With External Links\"
Would an enhancement of this be to look in all folders on the G drive?
It will look in .xls, .xlsx and .xlsm files.
Put this code into a standard code module in a workbook not in the speciied folder.
It will ask you to save any other workbooks that are open.
It wil not make changes to any files that it opens.
All you need to do is to change this line to include your folder name.
strFolder = "C:\Private\Training\Excel\Find Cells With External Links\"
Would an enhancement of this be to look in all folders on the G drive?
VBA Code:
Public Sub fncGetListOfExternalReferences()
Dim objFSO As FileSystemObject
Dim objFile As File
Dim strFolder As String
Dim objFolder As Folder
Dim Wb As Workbook
Dim Ws As Worksheet
Dim rngIncFormula As Range
Dim rngCell As Range
Dim lngRow As Long
Dim Wslist As Worksheet
Dim WsWorkbooksList As Worksheet
Dim WbList As Workbook
Dim arr() As String
Dim intCount As Integer
On Error GoTo Err_Handler
strFolder = "C:\Private\Training\Excel\Find Cells With External Links\"
ActiveWorkbook.Save
Application.ScreenUpdating = False
For Each Wb In Application.Workbooks
If Wb.Name <> ThisWorkbook.Name Then
Wb.Close
End If
Next Wb
Set WbList = ActiveWorkbook
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("LinksList").Delete
Worksheets("WorkbooksList").Delete
On Error GoTo 0
Application.DisplayAlerts = True
WbList.Worksheets.Add after:=WbList.Sheets(Sheets.Count)
ActiveSheet.Name = "WorkbooksList"
Set WsWorkbooksList = ActiveSheet
WsWorkbooksList.Range("A1:C1").Value = Array("Path", "Workbook", "Cell Count")
WbList.Worksheets.Add after:=WbList.Sheets(Sheets.Count)
ActiveSheet.Name = "LinksList"
Set Wslist = ActiveSheet
Wslist.Range("A1").Resize(, 7).Value = Array("Location", "Worksheet", "Cell Reference", "Formula", "Linked Workbook", "Linked Worksheet", "Linked Cell Reference")
Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder(strFolder)
lngRow = 1
Application.EnableEvents = False
For Each objFile In objFolder.Files
If InStr(1, ".xlsx,.xlsm,.xls", objFSO.GetExtensionName(objFile), vbTextCompare) > 0 Then
Workbooks.Open objFile, ReadOnly:=True, UpdateLinks:=False
Set Wb = ActiveWorkbook
intCount = 0
For Each Ws In Wb.Worksheets
On Error Resume Next
Set rngIncFormula = Ws.UsedRange.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rngIncFormula Is Nothing Then
For Each rngCell In rngIncFormula.Cells
If InStr(1, rngCell.Formula, "'", vbTextCompare) > 0 Then
intCount = intCount + 1
arr = Split(rngCell.Formula, "'")
' MsgBox Join(arr, vbCrLf)
' arr = Split(arr(1), "]")
lngRow = lngRow + 1
Wslist.Cells(lngRow, 1).Resize(1, 7).Value = Array(objFile, _
Ws.Name, _
rngCell.Address, _
Replace(Mid(rngCell.Formula, 2), ")", "", 1), _
Replace(Left(arr(1), InStr(1, arr(1), "]", vbTextCompare) - 1), "[", "", 1), _
Mid(arr(1), InStr(1, arr(1), "]", vbTextCompare) + 1), _
Replace(Mid(arr(2), 2), ")", "", 1))
End If
Next rngCell
End If
Next Ws
With WsWorkbooksList
.Range("A" & .Range("A" & WsWorkbooksList.Rows.Count).End(xlUp).Offset(1).Row).Resize(1, 3).Value = _
Array(Wb.Path, Wb.Name, intCount)
End With
Wb.Close SaveChanges:=False
End If
Next objFile
Application.EnableEvents = True
Wslist.Activate
Call subFormatWorksheet(Wslist)
Call subFormatWorksheet(WsWorkbooksList)
Application.ScreenUpdating = True
MsgBox "List of external references created.", vbOKOnly, "Confirmation"
Exit_Handler:
Exit Sub
Err_Handler:
MsgBox "There has been an error." & vbCrLf & _
"Number : " & Err.Number & vbCrLf & _
"Description : " & Err.Description & vbCrLf
Resume Exit_Handler
End Sub
Private Sub subFormatWorksheet(Ws As Worksheet)
Ws.Activate
With Ws.Range("A1").CurrentRegion
.RowHeight = 30
.VerticalAlignment = xlCenter
.IndentLevel = 1
With .Rows(1)
.Interior.Color = RGB(217, 217, 217)
.Font.Bold = True
End With
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = vbBlack
End With
.EntireColumn.AutoFit
With .Cells(2, 1)
.Select
ActiveWindow.FreezePanes = True
End With
End With
End Sub
Upvote
0
Hi Herakles
Thanks heaps! Yes, it would be great to do this in one hit, as there are hundreds of folders.
Upvote
0
I have tried running the code, but come up with this error "User-defined type not defined"
Attachments
Upvote
0
Sorry.
You need to make reference to the Microsoft Scripting Runtime Library.
This page tells you how to do it.
Microsoft Scripting Runtime Library
See this section.
Setting the Reference to the Microsoft Scripting Runtime Library
Upvote
0
You have been so patient. Thank you. I have added the reference, but when I run it comes up with a runtime error.
Attachments
Upvote
0
Has it written anything to the LinksList worksheet before the error?
Upvote
0
It has created the tabs and the headers, and downloads one excel workbook, then errors
Upvote
0
Similar threads
- Solved
