Microsoft Office Forums - View Single Post

scienceguy · 10-17-2019, 01:22 PM

Hello,

I'm writing an app that modifies each header from a folder of Word files, using an Excel VBA. The goals are:

Delete the existing header
Add a new table to the header
Populate the new table with information from Excel
Add "Page x of y" to one of the cells
Format the table

When I get to the Select code, an error is thrown. I'm guessing the document is not active in the proper way? The first error is thrown when I try to add "Page x of y" to cell(2,2). The next error is thrown when I try to right justify the second column.

I've provided some code below to illustrate the problem.

Any guidance would be appreciated.

Thank you,
Roy

Code:

Sub modifyHeader()

Dim wdApp As Object
Dim wdDoc As Object
Dim strFolder As String

With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
        strFolder = .SelectedItems(1)
    End If
End With
If strFolder = "" Then
    Exit Sub
End If

Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False

strfile = Dir(strFolder & "\*.doc", vbNormal)

While strfile <> ""
    Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strfile, AddToRecentFiles:=False, Visible:=False)
   
   
    'delete existing header
    wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete
    
    'add a table to header
    wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables.Add _
      Range:=wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range, _
      NumRows:=2, _
      NumColumns:=2
      
      With wdDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1)
          .Range.Font.Bold = True
          .Range.Font.Name = "Times New Roman"
          .Range.Font.Size = 10
          .Cell(1, 1).Range.Text = "ABC-000"
          .Cell(2, 1).Range.Text = "Manufacturer"
          
          .Cell(2, 2).Select
          With Selection
              .TypeText Text:="Page "
              .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="PAGE  \* Arabic ", PreserveFormatting:=True
              .TypeText Text:=" of "
              .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="NUMPAGES  ", PreserveFormatting:=True
          End With
          
          .Columns(2).Select
          With Selection
              .ParagraphFormat.Alignment = wdAlignParagraphRight
          End With
      
      End With


    
'Needed?
'    ActiveDocument.ActiveWindow.View.Type = wdPrintView
'    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'    ActiveDocument.ActiveWindow.View.Type = wdPrintView

    
    Application.DisplayAlerts = False
    wdDoc.Close True
    Application.DisplayAlerts = True
    
    strfile = Dir()
Wend

Set wdDoc = Nothing
wdApp.Quit
Set wdApp = Nothing


MsgBox "Finished!"

End Sub