View Single Post
 
Old 10-02-2015, 09:19 PM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,138
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

You are nearly there, but you are working in Excel and confusing Word VBA commands with those from Excel. If you are using LateBinding to Word, you cannot use any commands that are prefixed wd, so you must use their numeric equivalents, and Word components such as ranges and tables should be defined as objects. Then you get something like the following which will work from Excel.

Code:
Option Explicit
Private Get_File As String
Private objWord As Object
Private objDoc As Object
Private RUSure As Long

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
    Delete_Header_first_row objDoc
    RemoveSectionBreaks objDoc
    DeleteEmptyParas objDoc
    objDoc.Tables(1).Range.Copy
End Sub

Sub Delete_Header_first_row(odoc As Object)
Dim oTable As Object
For Each oTable In odoc.Range.Tables
    oTable.Rows(1).Delete
Next oTable
End Sub

Sub RemoveSectionBreaks(odoc As Object)
Dim rg As Object
    Set rg = odoc.Range
    With rg.Find
        .Text = "^b"        ' section break
        .Wrap = 0
        While .Execute
            rg.Delete
        Wend
    End With
End Sub

Sub DeleteEmptyParas(odoc As Object)

Dim MyRange As Object, oTable As Object, oCell As Object
    Set MyRange = odoc.Paragraphs(1).Range
    If Len(MyRange) = 1 Then MyRange.Delete

    Set MyRange = odoc.Paragraphs.Last.Range
    If Len(MyRange) = 1 Then MyRange.Delete

    For Each oTable In odoc.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 0
        'if para after table empty, delete it
        If Len(MyRange.Paragraphs(1).Range) = 1 Then
            MyRange.Paragraphs(1).Range.Delete
        End If
    Next oTable
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote