Forum Discussion
Thanh_Bui
Apr 28, 2022Copper Contributor
Excel Macro could not ignore broken link warning on OneDrive folder(works on Local folder & DropBox)
This code work on regular local drive but not on OneDrive folder.
Dim fileCollection As Collection
Sub BreakExternalLinks(wb As Workbook)
'PURPOSE: Breaks all external links that would show up in Excel's "Edit Links" Dialog Box
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim ExternalLinks As Variant
Dim x As Long
'Create an Array of all External Links stored in Workbook
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
If IsEmpty(ExternalLinks) = True Then Exit Sub
'Loop Through each External Link in ActiveWorkbook and Break it
For x = 1 To UBound(ExternalLinks)
ActiveWorkbook.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
Next x
End Sub
Sub TraversePath(path As String)
Dim currentPath As String, directory As Variant
Dim dirCollection As Collection
Set dirCollection = New Collection
currentPath = Dir(path, vbDirectory)
'Explore current directory
Do Until currentPath = vbNullString
Debug.Print currentPath
'MsgBox "curentPath " & currentPath & " last 4 =" & Right(currentPath, 4) & "StrCmp result = " & StrComp(Right(currentPath, 4), "xlsx")
If Left(currentPath, 1) <> "." And (GetAttr(path & currentPath) And vbDirectory) = vbDirectory Then
dirCollection.Add currentPath
ElseIf Left(currentPath, 1) <> "." And (GetAttr(path & currentPath) And vbNormal) = vbNormal And StrComp(Right(currentPath, 4), "xlsx") = 0 Then
fileCollection.Add (path & currentPath)
End If
currentPath = Dir()
Loop
'Explore subsequent directories
For Each directory In dirCollection
Debug.Print "---SubDirectory: " & amp; directory & amp; "---"
TraversePath path & directory & "\"
Next directory
End Sub
Sub RunOnAllFilesInSubFolders()
Dim folderName As String, eApp As Excel.Application, fileName As Variant
Dim wb As Workbook, ws As Worksheet, currWs As Worksheet, currWb As Workbook, rng As Range
Dim fDialog As Object: Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
Set currWb = ActiveWorkbook: Set currWs = ActiveSheet
'Select folder in which all files are stored
fDialog.Title = "Select a folder"
fDialog.InitialFileName = currWb.path
If fDialog.Show = -1 Then
folderName = fDialog.SelectedItems(1)
End If
'Create a separate Excel process that is invisibile
Set eApp = New Excel.Application: eApp.Visible = False
'Search for all files in folder [replace *.* with your pattern e.g. *.xlsx]
Set fileCollection = New Collection
TraversePath folderName & "\"
For Each fileName In fileCollection
'MsgBox "Check file " & fileName
'Update status bar to indicate progress
Application.StatusBar = "Processing " & fileName
eApp.DisplayAlerts = False
Set wb = eApp.Workbooks.Open(fileName, UpdateLinks:=True, ReadOnly:=False, IgnoreReadOnlyRecommended:=True)
'...
Dim ExternalLinks As Variant
Dim x As Long
Application.DisplayAlerts = False
ExternalLinks = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
If IsEmpty(ExternalLinks) = True Then
wb.Close SaveChanges:=False
Else
'Loop Through each External Link in ActiveWorkbook and Break it
For x = 1 To UBound(ExternalLinks)
wb.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
Next x
'...
wb.Save
wb.Close SaveChanges:=True 'Close opened worbook w/o saving, change as needed
End If
Debug.Print "Processed " & amp; fileName 'Print progress on Immediate window
Next fileName
eApp.Quit
Set eApp = Nothing
'Clear statusbar and notify of macro completion
Application.StatusBar = ""
MsgBox "Completed executing macro on all workbooks"
End Sub
When I try to put eApp.Visible = True I noticed that the broken link warning is not suppressed.
Is there any suggestion to fix this? In general I'm trying to break all the links (replace them to value) while migrating a lot of files from DropBox to OneDrive
5 Replies
- JMB17Bronze ContributorPerhaps try turning off alerts right before you break the links : Application.DisplayAlerts=False
But, be sure to turn them back on as it affects other alerts (such as "do you want to save changes" when you close the workbook).