How can I truncate a footer to the first 15 characters? Word 2010 vba

I am splitting a word document with multiple letters to individual files.  The text I want to use as the filename is in the first 14 characters of the footer.
I need to truncate the footer to name the files.  
I am very new to vba, any help would be greatly appreciated.
Below is my code :

Sub BreakOnPVOHSection()

Dim letter As Range
Dim fname As Range
Dim target As Document
Dim strFileName As String
Dim strID As String
    
 ' Used to set criteria for moving through the document by section.
 Application.Browser.target = wdBrowseSection

'A mailmerge document ends with a section break next page.
 For i = 1 To ((ActiveDocument.Sections.Count) - 1)
   
     Set fname = ActiveDocument.Sections(i).Footers(wdHeaderFooterPrimary).Range
     fname.End = fname.End - 1

   
      'Select and copy the section text to the clipboard
      ActiveDocument.Bookmarks("\Section").Range.Copy

      'Create a new document to paste text from clipboard.
      Documents.Add
      Selection.Paste
         
 '        ActiveDocument.Bookmarks = Mid(fname, 0, 12)
 
       ChangeFileOpenDirectory "\\vcuhshmo\users\lheaton\bpa"
       docnum = docnum + 1
       ActiveDocument.SaveAs fileName:=fname.Text & ".docx"

       ActiveDocument.Close savechanges:=wdDoNotSaveChanges
      ' Move the selection to the next section in the document
      Application.Browser.Next
   
   Next i
     
 ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub

Open in new window

jbndylanAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

GrahamSkanRetiredCommented:
Try it this way:
Sub BreakOnPVOHSection()

Dim strFileName As String
Dim docNew As Document
Dim sec As Section
Dim docA As Document
Dim rng As Range
Dim docnum As Integer

 Set docA = ActiveDocument 'capture initial active document into an object variable,
                          'so that we don't have to keep track of which document is currently active
                          
'A mailmerge document ends with a section break next page.
For Each sec In docA.Sections
   
    'truncate and delete any paragraph marks
    strFileName = Replace(Left(sec.Footers(wdHeaderFooterPrimary).Range, 14), vbCr, "")
     
    Set rng = sec.Range
    If Len(rng) = 1 Then 'last section
        Exit For
    End If
    rng.MoveEnd wdCharacter, -1 'drop section break
    rng.Copy

    'Create a new document to paste text from clipboard.
    Set docNew = Documents.Add
    docNew.Range.Paste
         
       docnum = docnum + 1
       'docNew.SaveAs FileName:="\\vcuhshmo\users\lheaton\bpa\" & strFileName & ".docx"
       docNew.SaveAs FileName:="C:\MyFolder\" & strFileName & ".docx"

       docNew.Close savechanges:=wdDoNotSaveChanges
Next sec
 docA.Close savechanges:=wdDoNotSaveChanges
End Sub

Open in new window

0
jbndylanAuthor Commented:
The naming works beautifully, thank you.  But it's stripping out the header, footer and formatting that are needed.  I will add those parts back in and see how it goes!!!  Thank you so much for resolving this naming thing.  Whew!
0
jbndylanAuthor Commented:
I'm sorry.  I was not clear regarding the header/footer.  Those I want to keep.  Only for the filename do I want to include the first 14 characters of the footer.  The names your code came up with are perfect.
0
GrahamSkanRetiredCommented:
This copies each header and each footer to the output documents
Sub BreakOnPVOHSection()

Dim strFileName As String
Dim docNew As Document
Dim sec As Section
Dim docA As Document
Dim rng As Range
Dim docnum As Integer

 Set docA = ActiveDocument 'capture initial active document into an object variable,
                          'so that we don't have to keep track of which document is currently active
                          
'A mailmerge document ends with a section break next page.
For Each sec In docA.Sections
   
    'truncate and delete any paragraph marks
    strFileName = Replace(Left(sec.Footers(wdHeaderFooterPrimary).Range.Text, 14), vbCr, "")
     
    Set rng = sec.Range
    If Len(rng) = 1 Then 'last section
        Exit For
    End If
    rng.MoveEnd wdCharacter, -1 'drop section break
    rng.Copy

    'Create a new document to paste text from clipboard.
    'copy main body
    Set docNew = Documents.Add
    docNew.Range.Paste
    'copy header
    sec.Headers(wdHeaderFooterPrimary).Range.Copy
    docNew.Sections(1).Headers(wdHeaderFooterPrimary).Range.Paste
    'copy footer
    sec.Footers(wdHeaderFooterPrimary).Range.Copy
    docNew.Sections(1).Footers(wdHeaderFooterPrimary).Range.Paste
    
    docnum = docnum + 1
    docNew.SaveAs FileName:="\\vcuhshmo\users\lheaton\bpa\" & strFileName & ".docx"
    'docNew.SaveAs FileName:="C:\MyFolder\" & strFileName & ".docx"
    docNew.Close savechanges:=wdDoNotSaveChanges
Next sec

docA.Close savechanges:=wdDoNotSaveChanges
End Sub

Open in new window

1

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
jbndylanAuthor Commented:
You are my hero of heros!!!!!!!!!!!!  I have been working on this forever.  Thank you!!!!!!!!!!!!!!!!!
You are a genius!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Word

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.