Private Sub Document_New()
End Sub
Sub RetrieveTableItems()
Dim oRow As Row
Dim oCell As Cell
Dim sCellText As String
Dim i As Integer
Dim strLine As String
Dim strLines As String
Dim OutputFileNum As Integer
' Turn on error checking.
On Error GoTo ErrorHandler
' Loop through each row in the table.
i = 1
For Each oRow In ActiveDocument.Tables(1).Rows
' Loop through each cell in the current row.
If i > 2 Then
For Each oCell In oRow.Cells
sCellText = oCell.Range
' Remove table cell markers from the text.
sCellText = Left$(sCellText, Len(sCellText) - 2)
strLine = strLine + sCellText + "|"
Next oCell
End If
strLines = strLines + strLine + "^"
strLine = ""
i = i + 1
Next oRow
OutputFileNum = FreeFile
Open "C:\Ahold\ChangeLog.txt" For Output Lock Write As #OutputFileNum
Print #OutputFileNum, strLines
Close OutputFileNum
MsgBox "Complete "
ErrorHandler:
If Err <> 0 Then
Dim Msg As String
Msg = "Error # " & Str(Err.Number) & Chr(13) & Err.Description _
& Chr(13) & "Make sure there is a table in the current document."
MsgBox Msg, , "Error"
End If
End Sub