![]() |
#1
|
|||
|
|||
![]()
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 |
Thread Tools | |
Display Modes | |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
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 |
![]() |
jc491 | Word VBA | 8 | 09-11-2015 08:31 AM |
![]() |
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 |