View Single Post
 
Old 06-13-2017, 02:18 PM
Rsloo Rsloo is offline Windows 7 32bit Office 2016
Novice
 
Join Date: Jun 2017
Location: Hawaii
Posts: 2
Rsloo is on a distinguished road
Default Extend Unlink Macro to reach documents in subfolders

Hi All,


New to VBA and these forums. While I don't have any formal VBA training, I was able to put together the following Macro using code copied from google searches. This macro works, run from VBA opened from Word 2016, and currently unlinks all links in the current Word document, and then searches and does the same for all other Word documents in the folder the current document resides in.


If possible I would like to extend it's reach to the relative subfolders as well. Additionally, I'd like to stick with docPath = ActiveDocument.Path & "\" or something similar, so that I wouldn't have to modify the macro every time I need it to run for a different folder.


See the macro below:

Sub RemoveLinks()
Dim fleArray() As String
Dim flCount As Long
Dim k As Long
Dim fle As String
Dim fld As Field
Dim currentFileName As String
Dim docPath As String
Dim bDirty As Boolean
Dim sRange As Range
Dim doc As Document

docPath = ActiveDocument.Path & "\"
currentFileName = ActiveDocument.Name
fle = Dir(docPath & "*.doc*")
flCount = -1
ReDim fleArray(0)
Do While fle <> ""
flCount = flCount + 1
ReDim Preserve fleArray(flCount)
fleArray(flCount) = fle
fle = Dir()
Loop
If MsgBox("There are " & flCount + 1 & " files to be processed." _
& vbCrLf & "Do you want to continue?", vbYesNo, "Break links") _
= vbNo Then Exit Sub


For k = 0 To UBound(fleArray)
fle = fleArray(k)
Options.UpdateLinksAtOpen = False
Documents.Open FileName:=docPath & fle
Options.UpdateLinksAtOpen = True
bDirty = False
For Each sRange In ActiveDocument.StoryRanges
For Each fld In sRange.Fields
If fld.Type = wdFieldLink Then
' Uncomment the following if link needs to be updated
' before the link is broken
' fld.Update
fld.Unlink
bDirty = True
End If
Next fld
Next sRange
If bDirty Then ActiveDocument.Save ' Only save if links broken
If ActiveDocument.Name <> currentFileName Then ActiveDocument.Close
Next k
End Sub

Any help would be greatly appreciated.

Thanks,
-Robert
Reply With Quote