none
How to Append Text to Multiple Word Documents RRS feed

  • Question

  • Hi All,

    I have around 1000 Microsoft Word Documents which all require the same text adding to the bottom.

    The text I would like to add is:

    Product Categorization

    Tier 1:

    Tier 2:

    Tier 3:

    Service Categorization

    Tier 1:

    Tier 2:

    Tier 3:

    The formatting of the text is required as font:Arial, Size:11, & Bold

    The files are all within one folder however are in sub folders

    Hope this is possible as it will save me a lot of work!!

    Many thanks


    • Edited by Luke Swinbourne Monday, March 11, 2013 6:37 PM
    • Moved by Bill_Stewart Monday, March 11, 2013 6:41 PM Move to more appropriate forum
    Monday, March 11, 2013 6:34 PM

Answers

  • Hi Luke,

    Try the following Word macro, which includes a browser you can simply point to the top folder.

    Option Explicit
    Public FSO As Object 'a FileSystemObject
    Public oFolder As Object 'the folder object
    Public oSubFolder As Object 'the subfolders collection
    Public oFiles As Object 'the files object
    Public i As Long, j As Long

    Sub Main()
    ' Minimise screen flickering
    Application.ScreenUpdating = False
    Dim StrFolder As String
    ' Browse for the starting folder
    StrFolder = GetTopFolder
    If StrFolder = "" Then Exit Sub
    i = 0: j = 0
    'initialize the counters
    ' Search the top-level folder
    Call GetFolder(StrFolder & "\")
    ' Search the subfolders for more files
    Call SearchSubFolders(StrFolder)
    ' Return control of status bar to Word
    Application.StatusBar = ""
    ' Restore screen updating
    Application.ScreenUpdating = True
    MsgBox i & " of " & j & " files updated.", vbOKOnly
    End Sub

    Function GetTopFolder() As String
    GetTopFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetTopFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function

    Sub SearchSubFolders(strStartPath As String)
    If FSO Is Nothing Then
      Set FSO = CreateObject("scripting.filesystemobject")
    End If
    Set oFolder = FSO.GetFolder(strStartPath)
    Set oSubFolder = oFolder.subfolders
    For Each oFolder In oSubFolder
      Set oFiles = oFolder.Files
      ' Search the current folder
      Call GetFolder(oFolder.Path & "\")
      ' Call ourself to see if there are subfolders below
      SearchSubFolders oFolder.Path
    Next
    End Sub

    Sub GetFolder(StrFolder As String)
    Dim strFile As String
    strFile = Dir(StrFolder & "*.doc")
    ' Process the files in the folder
    While strFile <> ""
      ' Update the status bar is just to let us know where we are
      Application.StatusBar = StrFolder & strFile
      Call UpdateFile(StrFolder & strFile)
      strFile = Dir()
    Wend
    End Sub

    Sub UpdateFile(strDoc As String)
    Dim Doc As Document
    Dim oItem As Object, StrDtTm As String
    StrDtTm = FileDateTime(strDoc)
    ' Open the document
    Set Doc = Documents.Open(strDoc, AddToRecentFiles:=False, ReadOnly:=False, Format:=wdOpenFormatAuto, Visible:=False)
    With Doc
      If .ProtectionType = wdNoProtection Then
        ' Update the document
        'First erase any trailing paragraph breaks
        With .Range
          While .Characters.Last.Previous.Text = vbCr
            .Characters.Last.Previous.Text = vbNullString
          Wend
          .InsertAfter vbCr
          'insert a new trailing paragraph break
          With .Paragraphs.Last.Range
            With .ParagraphFormat
              .SpaceBefore = 11
              .SpaceAfter = 11
            End With
            With .Font
              .Size = 11
              .Name = "Arial"
              .Bold = True
            End With
          End With
          .InsertAfter "Product Categorization" & vbCr & _
          "Tier 1:" & vbCr & "Tier 2:" & vbCr & "Tier 3:" _
          & vbCr & "Service Categorization" & vbCr & _
          "Tier 1:" & vbCr & "Tier 2:" & vbCr & "Tier 3:"
        End With
        ' Update the file counter for changed files
        i = i + 1
      Else
        ' Output a 'protected' file report in the document from which the macro is run.
        ThisDocument.Range.InsertAfter vbCr & strDoc & " protected. Not updated."
      End If
      ' Update the main file counter
      j = j + 1
      .Close SaveChanges:=True
    End With
    ' Let Word do its housekeeping
    DoEvents
    ' Reset the file's Date/Time stamp.
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    Set oItem = FSO.GetFile(strDoc)
    On Error Resume Next
    If IsDate(StrDtTm) Then
      If oItem.DateLastModified <> StrDtTm Then oItem.DateLastModified = StrDtTm
    End If
    Set Doc = Nothing
    End Sub

    A few notes:
    1. The macro uses paragraph before/after spacing to manage the inter-paragraph spacings, rather than empty paragraphs.
    2. The macro generates a report that includes details of any files it can't process (eg because they're password-protected)
    3. File date/time stamps are re-set to their previous values, so they might not appear to be changed. The code that does that is near the end. You can comment-out or delete that code.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Tuesday, March 12, 2013 3:53 AM
  • Hi Luke

    You use the term "script"... Are you needing to perform these actions server-side, or will this be on a local machine?

    Generally, you don't want to automate Word server-side. For that reason, as well as for reasons of efficiency, you might want to consider working directly with the closed files' Open XML if we're talking about files in the Word 2007 (and newer) file format.


    Cindy Meister, VSTO/Word MVP, my blog

    Friday, March 15, 2013 2:58 PM
    Moderator

All replies

  • Can you post your script? 

    What language are you using? 

    Have you tried asking this question in the MS Office forum?

    You can also look in the repository for examples of how to use MSWord and in the Office forum repository for the same,

    Note that this is an administrative scripting forum and not an end user support forum. Word has macro capability which can do as you ask but you need to post in the Office forum for how to use macros.


    ¯\_(ツ)_/¯

    Monday, March 11, 2013 6:38 PM
  • I am very new to this so I am sorry if anything I have is wrong

    The script I have got to add the text to one document is as below:-

    Dim FSO, txs, fld, fil, content
    Set FSO = CreateObject("Word.Application")

    Set fld = FSO.GetFolder("C:\Scripts\Word")
    For Each fil In fld.Files
        If Right(fil.Name, 3) = "doc" Then

    Set objWord = CreateObject("Word.Application")
    FSO.Visible = True

    Const END_OF_STORY = 6
    Const MOVE_SELECTION = 0

    objSelection.TypeParagraph()
    objSelection.TypeParagraph()
    objSelection.Font.Size = "11"
    objSelection.Font.Bold = True
    objSelection.TypeText "Remedy Product Categorization"
    objSelection.Font.Bold = False
    objSelection.TypeParagraph()
    objSelection.TypeParagraph()
    objSelection.Font.Size = "11"
    objSelection.Font.Bold = True
    objSelection.TypeText "Tier 1:"
    objSelection.Font.Bold = False
    objSelection.TypeParagraph()
    objSelection.TypeParagraph()
    objSelection.Font.Size = "11"
    objSelection.Font.Bold = True
    objSelection.TypeText "Tier 2:"
    objSelection.Font.Bold = False
    objSelection.TypeParagraph()
    objSelection.TypeParagraph()
    objSelection.Font.Size = "11"
    objSelection.Font.Bold = True
    objSelection.TypeText "Tier 3:"
    objSelection.Font.Bold = False
    objSelection.TypeParagraph()
    objSelection.TypeParagraph()
    objSelection.Font.Size = "11"
    objSelection.Font.Bold = True
    objSelection.TypeText "Remedy Service Categorization"
    objSelection.Font.Bold = False
    objSelection.TypeParagraph()
    objSelection.TypeParagraph()
    objSelection.Font.Size = "11"
    objSelection.Font.Bold = True
    objSelection.TypeText "Tier 1:"
    objSelection.Font.Bold = False
    objSelection.TypeParagraph()
    objSelection.TypeParagraph()
    objSelection.Font.Size = "11"
    objSelection.Font.Bold = True
    objSelection.TypeText "Tier 2:"
    objSelection.Font.Bold = False
    objSelection.TypeParagraph()
    objSelection.TypeParagraph()
    objSelection.Font.Size = "11"
    objSelection.Font.Bold = True
    objSelection.TypeText "Tier 3:"
    objSelection.Font.Bold = False
    objSelection.TypeParagraph()
    objSelection.TypeParagraph()

    objDoc.Save

        End If    
    Next

    Please point me in the right location if this is the wrong place to ask this question        

    Monday, March 11, 2013 7:14 PM
  • Hi Luke,

    Try the following Word macro, which includes a browser you can simply point to the top folder.

    Option Explicit
    Public FSO As Object 'a FileSystemObject
    Public oFolder As Object 'the folder object
    Public oSubFolder As Object 'the subfolders collection
    Public oFiles As Object 'the files object
    Public i As Long, j As Long

    Sub Main()
    ' Minimise screen flickering
    Application.ScreenUpdating = False
    Dim StrFolder As String
    ' Browse for the starting folder
    StrFolder = GetTopFolder
    If StrFolder = "" Then Exit Sub
    i = 0: j = 0
    'initialize the counters
    ' Search the top-level folder
    Call GetFolder(StrFolder & "\")
    ' Search the subfolders for more files
    Call SearchSubFolders(StrFolder)
    ' Return control of status bar to Word
    Application.StatusBar = ""
    ' Restore screen updating
    Application.ScreenUpdating = True
    MsgBox i & " of " & j & " files updated.", vbOKOnly
    End Sub

    Function GetTopFolder() As String
    GetTopFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetTopFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function

    Sub SearchSubFolders(strStartPath As String)
    If FSO Is Nothing Then
      Set FSO = CreateObject("scripting.filesystemobject")
    End If
    Set oFolder = FSO.GetFolder(strStartPath)
    Set oSubFolder = oFolder.subfolders
    For Each oFolder In oSubFolder
      Set oFiles = oFolder.Files
      ' Search the current folder
      Call GetFolder(oFolder.Path & "\")
      ' Call ourself to see if there are subfolders below
      SearchSubFolders oFolder.Path
    Next
    End Sub

    Sub GetFolder(StrFolder As String)
    Dim strFile As String
    strFile = Dir(StrFolder & "*.doc")
    ' Process the files in the folder
    While strFile <> ""
      ' Update the status bar is just to let us know where we are
      Application.StatusBar = StrFolder & strFile
      Call UpdateFile(StrFolder & strFile)
      strFile = Dir()
    Wend
    End Sub

    Sub UpdateFile(strDoc As String)
    Dim Doc As Document
    Dim oItem As Object, StrDtTm As String
    StrDtTm = FileDateTime(strDoc)
    ' Open the document
    Set Doc = Documents.Open(strDoc, AddToRecentFiles:=False, ReadOnly:=False, Format:=wdOpenFormatAuto, Visible:=False)
    With Doc
      If .ProtectionType = wdNoProtection Then
        ' Update the document
        'First erase any trailing paragraph breaks
        With .Range
          While .Characters.Last.Previous.Text = vbCr
            .Characters.Last.Previous.Text = vbNullString
          Wend
          .InsertAfter vbCr
          'insert a new trailing paragraph break
          With .Paragraphs.Last.Range
            With .ParagraphFormat
              .SpaceBefore = 11
              .SpaceAfter = 11
            End With
            With .Font
              .Size = 11
              .Name = "Arial"
              .Bold = True
            End With
          End With
          .InsertAfter "Product Categorization" & vbCr & _
          "Tier 1:" & vbCr & "Tier 2:" & vbCr & "Tier 3:" _
          & vbCr & "Service Categorization" & vbCr & _
          "Tier 1:" & vbCr & "Tier 2:" & vbCr & "Tier 3:"
        End With
        ' Update the file counter for changed files
        i = i + 1
      Else
        ' Output a 'protected' file report in the document from which the macro is run.
        ThisDocument.Range.InsertAfter vbCr & strDoc & " protected. Not updated."
      End If
      ' Update the main file counter
      j = j + 1
      .Close SaveChanges:=True
    End With
    ' Let Word do its housekeeping
    DoEvents
    ' Reset the file's Date/Time stamp.
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    Set oItem = FSO.GetFile(strDoc)
    On Error Resume Next
    If IsDate(StrDtTm) Then
      If oItem.DateLastModified <> StrDtTm Then oItem.DateLastModified = StrDtTm
    End If
    Set Doc = Nothing
    End Sub

    A few notes:
    1. The macro uses paragraph before/after spacing to manage the inter-paragraph spacings, rather than empty paragraphs.
    2. The macro generates a report that includes details of any files it can't process (eg because they're password-protected)
    3. File date/time stamps are re-set to their previous values, so they might not appear to be changed. The code that does that is near the end. You can comment-out or delete that code.


    Cheers
    Paul Edstein
    [MS MVP - Word]

    Tuesday, March 12, 2013 3:53 AM
  • Hi Luke

    You use the term "script"... Are you needing to perform these actions server-side, or will this be on a local machine?

    Generally, you don't want to automate Word server-side. For that reason, as well as for reasons of efficiency, you might want to consider working directly with the closed files' Open XML if we're talking about files in the Word 2007 (and newer) file format.


    Cindy Meister, VSTO/Word MVP, my blog

    Friday, March 15, 2013 2:58 PM
    Moderator