Option Explicit
  Dim Get_File As String
  Dim objWord As Object
  Dim objDoc As Object
  Dim objSelection As Object
  Dim i As Long
  Dim wdCharacter As Boolean
  Dim wdExtend As Boolean
   
  Sub OpenDoc()
      
        'instructions to user
      MsgBox ("Please select the Word Document you would like to convert.")
      ' Display Open dialog
      With Application.FileDialog(1) ' msoFileDialogOpen
          .Filters.Clear
          .Filters.Add "Word documents", "*.doc*"
          If .Show Then
              Get_File = .SelectedItems(1)
          Else
              MsgBox "No document selected.", vbExclamation
              Exit Sub
          End If
      End With
      On Error Resume Next
      RUsure = MsgBox("Is this the correct Word Document?" & vbNewLine & Get_File, vbYesNo)
      If RUsure = vbYes Then
      ' See if Word is already running; if not, start it
      Set objWord = GetObject(Class:="Word.Application")
      If objWord Is Nothing Then
          Set objWord = CreateObject(Class:="Word.Application")
          If objWord Is Nothing Then
              MsgBox "Can't start Word.", vbExclamation
              Exit Sub
          End If
          End If
          
      End If
      ' Open document
      Set objDoc = objWord.Documents.Open(Filename:=Get_File) 'opens the word document
      objWord.Visible = True 'makes ms word application visible
      objDoc.Select
      Set objSelection = objWord.Selection
      Delete_Header_first_row
            
        End Sub
   
  Sub Delete_Header_first_row()
          Dim tblcnt As Integer
          With objDoc
          tblcnt = objDoc.Tables.Count
      For i = 1 To objDoc.Tables.Count
      objWord.Tables(i).Cells(1, 1).Select
      objWord.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
      objDoc.Rows.Delete
      
      Next i
      End With
      RemoveSectionBreaks
      DeleteEmptyParas
      objDoc.Tables(1).Range.Copy
   
  End Sub
  Sub RemoveSectionBreaks()
      Dim rg As Range
      Set rg = activedocument.Range
      With rg.Find
          .Text = "^b" ' section break
          .Wrap = wdFindStop
          While .Execute
              rg.Delete
          Wend
      End With
  End Sub
  Sub DeleteEmptyParas()
   
  Dim MyRange As Range, oTable As Table, oCell As Cell
   
  Set MyRange = activedocument.Paragraphs(1).Range
  If MyRange.Text = vbCr Then MyRange.Delete
   
  Set MyRange = activedocument.Paragraphs.Last.Range
  If MyRange.Text = vbCr Then MyRange.Delete
   
  For Each oTable In activedocument.Tables
      #If VBA6 Then
          'The following is only compiled and run if Word 2000 or 2002 is in use
           'It speeds up the table and your code
           oTable.AllowAutoFit = False
      #End If
   
      'Set a range to the para following the current table
       Set MyRange = oTable.Range
      MyRange.Collapse wdCollapseEnd
      'if para after table empty, delete it
      If MyRange.Paragraphs(1).Range.Text = vbCr Then
          MyRange.Paragraphs(1).Range.Delete
      End If
   
      Next oTable
   
  End Sub