'
'  WordCleaner.lss
'
'  Time-stamp: <2002-06-15 21:49:15 daniel.eriksson>
'
'  Date        Author           Changes
'  ----------  ---------------  ------------------------------------
'  2002-06-15  Daniel Eriksson  Created
'
'

'Some constants used in the Word VBA API.
'
'Headers and footers
Private Const wdHeaderFooterEvenPages = 3
Private Const wdHeaderFooterFirstPage = 2
Private Const wdHeaderFooterPrimary = 1
'
' wdSeekView constants
Private Const wdSeekMainDocument      =       0
Private Const wdSeekPrimaryHeader     =       1
Private Const wdSeekFirstPageHeader   =       2
Private Const wdSeekEvenPagesHeader   =       3
Private Const wdSeekPrimaryFooter     =       4
Private Const wdSeekFirstPageFooter   =       5
Private Const wdSeekEvenPagesFooter   =       6
Private Const wdSeekFoonotes  =       7
Private Const wdSeekEndNotes  =       8
Private Const wdSeekCurrentPageHeader =       9
Private Const wdSeekCurrentPageFooter =       10
'
' wdReplace constants
Private Const wdReplaceNonel  =       0
Private Const wdReplaceOne    =       1
Private Const wdReplaceAll    =       2
'
' wdFindWrap constants
Private Const wdFindStop      =       0
Private Const wdFindContinue  =       1
Private Const wdFindAsk       =       2
'
'WdCollapseDirection constants
Private Const wdCollapseStart = 0
Private Const wdCollapseEnd = 1


Public Class WordCleaner
' This class is used to manipulate a MicroSoft Word 
' document before importing it into a Notes database.
' Since the Notes import filter can't handle some Word features
' properly, your document will look better
' if you prepare the doucment with this class before 
' importing it.
'
' Usage:
'   Dim word as Variant
'   Set word = CreateObject("Word.Application")
'   word.documents.open(file)
'
'   Dim cleaner As New WordCleaner(word)
'   Call cleaner.ConvertFootNotes()
'   Call cleaner.SetFont("Times New Roman")
'   Call cleaner.DeleteHeadersAndFooters()
'   Call cleaner.SetLeftMargin(2.5)
'   Call cleaner.ConvertQuotes()
'
  m_word As Variant
  
  Public Sub New(wordApp As Variant)
    Set m_word = wordApp
  End Sub
  
  Public Sub ConvertFootNotes()
  ' Converts Word foot notes to text, and puts the text
  ' at the end of the document. If you import a Word document as is
  ' the foot notes will appear in the middle of the text.
  '
    Dim temp_range As Variant 'Range
    
    Dim notes_text As String
    notes_text = ""
    
    Dim footnote_index As Integer
    Dim footnote_count As Integer
    footnote_count = m_word.ActiveDocument.Footnotes.Count
    For footnote_index = 1 To footnote_count
      notes_text = notes_text & "(" & footnote_index & ") " & _
      GetFootNoteText(footnote_index)
      
      Set temp_range = m_word.ActiveDocument.Footnotes(footnote_index).Reference
      Call temp_range.Collapse(wdCollapseEnd)
      temp_range.Text = "(" & footnote_index & ")"
    Next
    
    Call DeleteFootNotes
    Call InsertEndNotes(notes_text)
  End Sub
  
  Private Function GetFootNoteText(footNoteIndex As Integer) As String
    Dim para_index As Integer
    Dim temp_range As Variant 'Range
    Dim footnote_text As String
    footnote_text = ""
    
    For para_index = 1 To m_word.ActiveDocument.Footnotes(footNoteIndex). _
    Range.Paragraphs.Count
      
      Set temp_range = m_word.ActiveDocument.Footnotes(footNoteIndex).Range. _
      Paragraphs(para_index).Range 
      
               'The first paragraph begins with the note reference. We don't want it.
      If para_index = 1 Then
        temp_range.SetRange temp_range.start + 1, temp_range.End - 1
      Else
        temp_range.SetRange temp_range.start, temp_range.End - 1
      End If
      
      footnote_text = footnote_text + temp_range.Text & Chr(10) & Chr(13)
      
    Next
    GetFootNoteText = footnote_text
  End Function
  
  Private Sub DeleteFootNotes()
    Dim footnote_index As Integer
    Dim footnote_count As Integer
    footnote_count = m_word.ActiveDocument.Footnotes.Count
    For footnote_index = 1 To footnote_count
      m_word.ActiveDocument.Footnotes(1).Delete
    Next
  End Sub
  
  Private Sub InsertEndNotes(notesText As String)
    Dim end_notes As Variant 'Range
    Set end_notes = m_word.ActiveDocument.Range(,)
    Call end_notes.InsertAfter("********" & Chr(10) & Chr(13) & notesText)
  End Sub
  
  Public Sub SetFont(font As String)
  ' Changes the font of the whole document.
    Call m_word.Selection.WholeStory
    m_word.Selection.Font.Name = font
  End Sub
  
  Public Sub DeleteHeadersAndFooters()
  ' Deletes all headers and footers
  ' in all sections of a document.
    
    Dim i As Integer
    For i = 1 To m_word.ActiveDocument.Sections.Count
      Call DeleteHeaderOrFooter(m_word.ActiveDocument.Sections(i).Headers(wdHeaderFooterFirstPage))
      Call DeleteHeaderOrFooter(m_word.ActiveDocument.Sections(i).Headers(wdHeaderFooterEvenPages))
      Call DeleteHeaderOrFooter(m_word.ActiveDocument.Sections(i).Headers(wdHeaderFooterPrimary))
      Call DeleteHeaderOrFooter(m_word.ActiveDocument.Sections(i).Footers(wdHeaderFooterFirstPage))
      Call DeleteHeaderOrFooter(m_word.ActiveDocument.Sections(i).Footers(wdHeaderFooterEvenPages))
      Call DeleteHeaderOrFooter(m_word.ActiveDocument.Sections(i).Footers(wdHeaderFooterPrimary))
    Next
  End Sub
  
  Private Sub DeleteHeaderOrFooter(headerOrFooter As Variant) 'HeaderFooter
    If (headerOrFooter.Exists) Then
      headerOrFooter.LinkToPrevious = False
      headerOrFooter.Range.Delete
    End If
  End Sub
  
  Public Sub SetLeftMargin(centimeters As Double)
    m_word.ActiveDocument.PageSetup.LeftMargin = m_word.CentimetersToPoints(centimeters)
  End Sub
  
  Public Sub Replace(oldText As String, newText As String)
    m_word.Selection.Find.ClearFormatting
    m_word.Selection.Find.Replacement.ClearFormatting
    m_word.Selection.Find.Text = oldText
    m_word.Selection.Find.Replacement.Text = newText
    m_word.Selection.Find.Forward = True
    m_word.Selection.Find.Wrap = wdFindContinue
    
          'expression.Execute(FindText, MatchCase, MatchWholeWord, _
          'MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward, _
          'Wrap, Format, ReplaceWith, Replace, MatchKashida, MatchDiacritics, _
          'MatchAlefHamza, MatchControl)  
    Call m_word.Selection.Find.execute(,,,,,,,,,,wdReplaceAll)
  End Sub
  
  Public Sub ConvertQuotes
    m_word.Options.AutoFormatAsYouTypeReplaceQuotes = False   
    Call Replace(Uchr(8220), """")
    Call Replace(Uchr(8221), """")
  End Sub
  
  End Class