Hi all,
I'm by no means a VBA expert, in fact I'd say my knowledge is pretty limited, but I have the following code that worked great (Broke links) when working within folders, since I'm now using Sharepoint the Macro can't seem to see and files within Sharepoint. How can this be amended to find the list of files within Sharepoint so I can break the links?
I'd really appreciate any help with this. Is it a simple fix, or is it not even possible?
I'm by no means a VBA expert, in fact I'd say my knowledge is pretty limited, but I have the following code that worked great (Broke links) when working within folders, since I'm now using Sharepoint the Macro can't seem to see and files within Sharepoint. How can this be amended to find the list of files within Sharepoint so I can break the links?
I'd really appreciate any help with this. Is it a simple fix, or is it not even possible?
VBA Code:
Public Sub BreakLinks()
Dim vntLinkSources As Variant
Dim vntLinkSource As Variant
Dim strDirectory As String
Dim strFileName As String
Dim wbkFile As Workbook
Dim lngCounter As Long
Dim ParentFolder As Object, ChildFolder As Object
On Error GoTo ErrHandler
With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Break Links"
.Title = "Select folder to break links"
If .Show Then
strDirectory = .SelectedItems(1) & "\"
Else
GoTo ExitProc
End If
End With
'**************************** New code ***
Process_Workbooks_In_Folder (strDirectory)
'*** New code ***
MsgBox lngCounter & " link(s) were broken.", vbInformation
MsgBox ("Process Completed")
ExitProc:
On Error Resume Next
wbkFile.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set wbkFile = Nothing
Exit Sub
ErrHandler:
'MsgBox Err.Description, vbExclamation
Resume ExitProc
End Sub
Private Sub Process_Workbooks_In_Folder(folderPath As String)
Static FSO As Object
Dim Folder As Object, Subfolder As Object, File As Object
If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
'Process files in this folder
Set Folder = FSO.GetFolder(folderPath)
For Each File In Folder.Files
If File.Name Like "*.x*" Then
' MsgBox (File.Path)
BreakTheLinks File.Path
End If
Next
'Process files in subfolders
For Each Subfolder In Folder.SubFolders
Process_Workbooks_In_Folder Subfolder.Path
Next
End Sub
Private Sub BreakTheLinks(workbookFilepath As String)
Dim strJustPath As String
Dim IntDifference As Integer
'MsgBox (workbookFilepath)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
strFileName = Dir(workbookFilepath)
Do Until Len(strFileName) = 0
IntDifference = Len(strFileName)
strJustPath = Left(workbookFilepath, Len(workbookFilepath) - IntDifference)
'MsgBox (strJustPath)
Set wbkFile = Workbooks.Open(strJustPath & strFileName, False)
vntLinkSources = wbkFile.LinkSources(xlExcelLinks)
If Not IsEmpty(vntLinkSources) Then
For Each vntLinkSource In vntLinkSources
wbkFile.BreakLink vntLinkSource, xlLinkTypeExcelLinks
lngCounter = lngCounter + 1
Next vntLinkSource
End If
wbkFile.Close True
strFileName = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Last edited by a moderator: