Forum Discussion

Thanh_Bui's avatar
Thanh_Bui
Copper Contributor
Apr 28, 2022

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

  • JMB17's avatar
    JMB17
    Bronze Contributor
    Perhaps 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).
    • Thanh_Bui's avatar
      Thanh_Bui
      Copper Contributor

      JMB17 

      if you check the source code, Application.DisplayAlerts=False is already there (line 75 and also line 82)

      • JMB17's avatar
        JMB17
        Bronze Contributor

        Thanh_Bui  Sorry, I missed that. It appears there is an option to 'ask to update automatic links'. Perhaps see if that is the issue?

         

         

Resources