#1
|
|||
|
|||
Batch Hyperlinking files
I’m hoping somebody can help me! I’ve had a long search here and can’t find anything that answers my query and I can’t believe I’m the first person ever to need to do this so hopefully it’s something you all know and I just don’t!
I have an word file that acts as an index for a large number of files (in excess of a 1000) currently these files, of various formats are stored within folders and subfolders which use the naming convention 01-Introduction though to 20-Acceptance certificate. Some of the folders have multiple subfolders, as in within 01-Introduction there is a subfolder called 01.01- Introduction slides. Some subfolders go 5 or 6 levels deep so it could end up being 01.01.01.01.01.01 and then a single file in there. Currently my predecessor manually made for each folder and file a (Relative) hyperlink manually which took hours /weeks and is probably why he’s not here anymore! The links all need to be relative, not absolute as the final file is issued back to client for storage on their server. (Yes we can ensure the relative structure is maintained) As a starter I’m trying to understand if there is a way of using VBA to look at my folder structure and then build the links for me. The dream would be if word could then allocate a text style based on what level the subfolder was. i.e. 01-Introduction would be heading style 1 01.01 would be heading style 2. And before everyone shouts just use excel, we can’t can’t. The client stipulates docx and pdf only. |
#2
|
||||
|
||||
To what folder are the hyperlink paths relative?
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
If I understand the question correctly (I’m not that smart)
The index file is within the very top level folder. So the top level folder is the scheme name and this folder contains the Index Document and then the 1-20 top level folders only. |
#4
|
||||
|
||||
Try:
Code:
Option Explicit Dim FSO As Object, oFolder As Object, StrFolds As String, StrFldr As String, wdDoc As Document Sub Main() Application.ScreenUpdating = False ActiveWindow.View.ShowFieldCodes = True Dim SubFldrs As Variant, SubFldr As Variant, i As Long Set wdDoc = ActiveDocument StrFldr = wdDoc.Path: StrFolds = vbCr & StrFldr If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject") End If 'Get the sub-folder structure Set SubFldrs = FSO.GetFolder(StrFldr).SubFolders For Each SubFldr In SubFldrs RecurseWriteFolderName (SubFldr) Next 'Process the documents in each folder For i = 1 To UBound(Split(StrFolds, vbCr)) Call UpdateDocList(CStr(Split(StrFolds, vbCr)(i))) Next With wdDoc.Range.Find .ClearFormatting .Replacement.ClearFormatting .Text = "[^13]{2,}" .Replacement.Text = "^p" .Forward = True .Wrap = wdFindContinue .Format = False .MatchWildcards = True .Execute Replace:=wdReplaceAll End With Set wdDoc = Nothing ActiveWindow.View.ShowFieldCodes = False Application.ScreenUpdating = True End Sub Sub UpdateDocList(strFolder As String) Dim strFile As String, strRelPath As String, Fld As Field, Rng As Range, h As Long strRelPath = Replace(strFolder & "\", StrFldr & "\", "") h = UBound(Split(strRelPath & "\", "\")) With wdDoc.Range If h = 1 Then .InsertAfter vbCr & "This Folder" & vbCr Else .InsertAfter vbCr & strRelPath & vbCr End If .Paragraphs.Last.Previous.Style = "Heading " & h End With strFile = Dir(strFolder & "\*.doc", vbNormal) While strFile <> "" If strFolder & "\" & strFile <> wdDoc.FullName Then With wdDoc.Range .InsertAfter vbCr Set Rng = .Hyperlinks.Add(.Characters.Last, "/../" & strRelPath & strFile, , , Split(strFile, ".doc")(0)).Range With Rng .MoveStartUntil "/", wdForward .Collapse wdCollapseStart .Fields.Add Range:=.Duplicate, Type:=wdFieldEmpty, Text:="FILENAME \p", PreserveFormatting:=False End With End With End If strFile = Dir() Wend End Sub Function GetFolder() As String Dim oFolder As Object GetFolder = "" Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0) If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path Set oFolder = Nothing End Function Sub RecurseWriteFolderName(aFolder) Dim SubFolders As Variant, SubFolder As Variant Set SubFolders = FSO.GetFolder(aFolder).SubFolders StrFolds = StrFolds & vbCr & CStr(aFolder) On Error Resume Next For Each SubFolder In SubFolders RecurseWriteFolderName (SubFolder) Next End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Thanks so much for this, it’s massively appreciated. I have had a quick play and it looks pretty much spot on. One issue is that each header shows the full pile path not just that header.
I’ll have a proper sit down with it over the weekend! Thanks again! |
#6
|
||||
|
||||
Quote:
.InsertAfter vbCr & strRelPath & vbCr to: .InsertAfter vbCr & Split(strRelPath, "")(h - 2) & vbCr
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#7
|
|||
|
|||
Thanks again Paul. What you have provided is great and is so close to what I need to achieve. I appreciate that your not here just to provide the script for me and I'm trying to learn VBA but it's quite a learning curve to achieve this. I will try and resolve this myself but if your generosity extends to look at this I've added a onedrive link below to a dummy folder structure. This includes a word doc which includes the heading structure etc I need to end up with, It might make more sense than how I have described it!
Microsoft services Like I said if you cannot assist, I completely understand. Thanks again. Last edited by neilwhite; 04-20-2020 at 03:29 AM. Reason: I cant spell! |
#8
|
||||
|
||||
Change:
strFile = Dir(strFolder & "\*.doc", vbNormal) to: strFile = Dir(strFolder & "\*.*", vbNormal) After: .InsertAfter vbCr insert: .Paragraphs.Last.Style = "Heading " & h + 1 Change: Set Rng = .Hyperlinks.Add(.Characters.Last, "/../" & strRelPath & strFile, , , Split(strFile, ".doc")(0)).Range to: Set Rng = .Hyperlinks.Add(.Characters.Last, "/../" & strRelPath & strFile, , , strFile).Range
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#9
|
|||
|
|||
Paul, you are a star!
I have just 2 issues now! (tell me to go away, honestly I'll understand!) When I run it, it includes the very top level folder that the document is saved in. 01 comes up as '01 This Folder', I should get '01 Introduction' and I get '01.01 Introduction\' instead. So then everything is then 1 level out. It also gives me the spurious '\' at the end of that as well. That's only happening AT THE 01.01 folder level. It doesn't do it at other levels? Finally the hyperlinks don't now work! I get a 'security concern' pop up which I accept then I get 'an unexpected error has occurred' error. When I hover over the link it shows File:///c:\01 - Introduction - I cant see where the extra c:\ is coming from. Is that linked to the issue of being 1 level too far down the tree? |
#10
|
||||
|
||||
Quote:
Change: .InsertAfter vbCr & "This Folder" & vbCr to: .InsertAfter vbCr & Split(StrFldr, "\")(UBound(Split(StrFldr, "\"))) & vbCr Regarding the '01.01 Introduction\' issue - Change: .InsertAfter vbCr & strRelPath & vbCr to: .InsertAfter vbCr & Split(strRelPath, "\")(0) & vbCr Quote:
If it's the latter, that's most likely because when you use Word to hyperlink to another file type, Windows recognises there's an issue, then Word's attempt to open the file fails.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
batch processing, hyperlinking |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Batch Comparing Multiple Word Files | scienceguy | Word VBA | 2 | 10-27-2021 07:43 AM |
Batch add suffix to PDF files in folder | Dave T | Windows | 2 | 03-01-2016 08:07 PM |
Remove Compatibility Mode on DOCX files (batch) | w64bit | Word | 17 | 02-01-2015 06:02 AM |
how to batch update linked image files path? | stanleyhuang | Word | 3 | 09-11-2014 12:51 AM |
Hyperlinking files on a mapped network drive | howler2345 | Outlook | 0 | 12-21-2011 08:54 AM |