View Single Post
 
Old 06-20-2014, 05:28 PM
macropod's Avatar
macropod macropod is offline Windows 7 32bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,962
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

You can't do it that way. For starters, the chevrons (i.e. '« »') cannot be inserted as text - they're part of the actual mergefields.

Instead, you could use a macro like the following, to add the active sheet's header row names (assumed to be on row 1, as per normal mailmerge configuration) to the designated document as mergefields. You will need to change the file reference in StrDocNm to point to your folder & document. As coded, it looks for a file named 'Document Name.doc' in your Documents folder.

Code:
Sub Demo()
Application.ScreenUpdating = True
Dim wdApp As Word.Application, wdDoc As Word.Document, StrDocNm As String
Dim bStrt As Boolean, bFound As Boolean
Dim xlWkSht As Worksheet, i As Long, lCol As Long
'Check whether the document exists
StrDocNm = "C:\Users\" & Environ("Username") & "\Documents\Document Name.doc"
If Dir(StrDocNm) = "" Then
  MsgBox "Cannot find the designated document: " & StrDocNm, vbExclamation
  Exit Sub
End If
' Test whether Word is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Word, so we can close it later.
Set wdApp = GetObject(, "Word.Application")
'Start Word if it isn't running
If wdApp Is Nothing Then
  Set wdApp = CreateObject("Word.Application")
  If wdApp Is Nothing Then
    MsgBox "Can't start Word.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Word, so we can terminate it later.
  bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open.
bFound = False
With wdApp
  'Hide our Word session
  If bStrt = True Then .Visible = False
  For Each wdDoc In .Documents
    If wdDoc.FullName = StrDocNm Then ' We already have it open
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrDocNm) = True Then
      ' Report and exit if true
      MsgBox "The Word document is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set wdDoc = .Documents.Open(Filename:=StrDocNm, AddToRecentFiles:=False, ReadOnly:=False)
    If wdDoc Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrDocNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  'Reference our worksheet
  Set xlWkSht = ActiveSheet
  'get the column count
  lCol = xlWkSht.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Column
  With wdDoc
    'Only now can we can process the document!!!
    'Add a mergefield to the document, corresponding to each 'heading' cell in our worksheet.
    For i = 1 To lCol
      If Trim(xlWkSht.Cells(1, i).Text) <> "" Then
        .Fields.Add Range:=.Characters.Last, Type:=wdFieldEmpty, _
        Text:="MERGEFIELD " & xlWkSht.Cells(1, i).Text, PreserveFormatting:=False
      End If
    Next
    If bFound = False Then .Close SaveChanges:=True
  End With
  If bStrt = True Then .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing: Set xlWkSht = Nothing
End Sub
Function IsFileLocked(strFileName As String) As Boolean
  On Error Resume Next
  Open strFileName For Binary Access Read Write Lock Read Write As #1
  Close #1
  IsFileLocked = Err.Number
  Err.Clear
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote