Selecting text from a specific column in Word with VBA - vba

Question

I have a document which is separated by section breaks.
Within each section I may have zero or one column breaks.
I want to extract the text from the first column of each section that contains 2 columns, like so:
For Each oSec In ActiveDocument.Sections
iSectionStart = oSec.Range.Start
iSectionEnd = oSec.Range.End
i = oSec.PageSetup.TextColumns.Count
If (2 = i) Then
' Update the range to only contain the text in textcolumn 1
' then select and copy it to a destination string
End If
Next oSec
However, the TextColumns object does not seem to have a method for returning the column contents.

Answer 1

TextColums.Count is actually not specified by the number of Column Breaks. You can have 2 columns (i.e. TextColumns.Count = 2) without a single Column Break.
If you for instance create a new document, fill it with random text by typing
=Rand(100)
and hit enter and select Two Columns from the Layout Tab. You will notice that you get two columns over 8 pages or so where none of the pages have Column Breaks.
The Office Object Model does not provide with an option to automatically select a specific column on a specifice page within a section. If the document actually has Column Breaks you can use the Find option to find the Column Break and from there select the Range from the start of the page to the start of the Column Break character that you just found using the Find option. Not a trivial thing to do as you can see.

Answer 2

Since the column break marker is represented by the ASCII value 14, all I had to do was look at each word in the section until I found the expected marker
Sub ExtractColumnText()
'
' On pages with no columns, the text is copied to both output files
' On pages with two columns, the column1 text is copied to "C:\DocTemp\Italian.doc"
' and column2 text is copied to "C:\DocTemp\English.doc"
'
Dim DestFileNum1 As Long
Dim DestFileNum2 As Long
Dim strDestFile1 As String
Dim strDestFile2 As String
Dim strCol1 As String
Dim strCol2 As String
Dim i As Integer
Dim oSec As Section
Dim oRngCol1 As Range
Dim oRngCol2 As Range
Dim oRngWord As Range
strDestFile1 = "C:\DocTemp\Italian.doc" 'Location of external file
DestFileNum1 = FreeFile()
strDestFile2 = "C:\DocTemp\English.doc" 'Location of external file
DestFileNum2 = DestFileNum1 + 1
Open strDestFile1 For Output As DestFileNum1
Open strDestFile2 For Output As DestFileNum2
For Each oSec In ActiveDocument.Sections
Set rngWorking = oSec.Range.Duplicate
Set oRngCol1 = rngWorking.Duplicate
oRngCol1.End = rngWorking.End - 1 ' exclude the page break
Set oRngCol2 = oRngCol1.Duplicate
If 2 <= oSec.PageSetup.TextColumns.Count Then
'examine each word in the section until we switch columns
For Each rngWord In rngWorking.Words
' 14 = column break marker
If 14 = AscW(rngWord.Text) Then
oRngCol1.End = rngWord.Start
oRngCol2.Start = rngWord.End
GoTo Xloop
End If
Next rngWord
End If
Xloop:
oRngCol1.Select
Print #DestFileNum1, oRngCol1.Text
oRngCol2.Select
Print #DestFileNum2, oRngCol2.Text
Next oSec
Close #DestFileNum1
Close #DestFileNum2
MsgBox "Done!"
End Sub