Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #1  
Old 06-13-2017, 02:18 PM
Rsloo Rsloo is offline Extend Unlink Macro to reach documents in subfolders Windows 7 32bit Extend Unlink Macro to reach documents in subfolders Office 2016
Novice
Extend Unlink Macro to reach documents in subfolders
 
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
 



Similar Threads
Thread Thread Starter Forum Replies Last Post
Extend Unlink Macro to reach documents in subfolders How many more surveys needed to reach certain goal jenreindunca Excel 1 01-29-2017 07:06 AM
Macro to change/convert/delete txt files in folder+subfolders NoS Word VBA 4 03-03-2016 12:10 PM
Extend Unlink Macro to reach documents in subfolders How To Apply A VBA Macro to All Subfolders in a Directory of a docx. Extension jc491 Word VBA 8 09-11-2015 08:31 AM
Extend Unlink Macro to reach documents in subfolders Macro to loop in subfolders, change links, export xml data Catalin.B Excel Programming 2 09-08-2011 11:37 PM
Outlook 2003: Your message did not reach some or all of the markgrossman Outlook 15 10-21-2010 05:35 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 09:18 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft