could not able to get the changes done to a word 2007 table

[RAMA]

Hi, Can some one help me in extracting the changes done to a word 2007 table.
If a table has been modified, like .. deleted a cell or a row I could not
able to track that change ... I am also providing you the code that I have
coded...can some one help me in this ....

Public Sub ExtractTrackedChangesToNewDoc()
Dim oDoc As Document
Dim oNewDoc As Document
Dim oTable As Table
Dim oRow As Row
Dim oCol As Column
Dim oRange As Range
Dim oRevision As Revision
Dim strText As String
Dim strTable As String
Dim n As Long
Dim i As Long
Dim Title As String
Dim strTextTable As String
Dim ChangeType As String
Dim strSQL As String
Dim iShape As InlineShape

Dim MyConnObj As New ADODB.Connection 'ADODB Connection Object
Dim myRecSet As New ADODB.Recordset 'Recordset Object
Dim sqlStr As String ' String variable to store sql command

Title = "Extract Tracked Changes to New Document"
n = 0 'use to count extracted changes

Set oDoc = ActiveDocument

If oDoc.Revisions.Count = 0 Then
MsgBox "The active document contains no tracked changes.", vbOKOnly,
Title
GoTo ExitHere
Else
'Stop if user does not click Yes
If MsgBox("Do you want to extract tracked changes to a new
document?" & vbCr & vbCr & _
"NOTE: Only insertions and deletions will be included. " & _
"All other types of changes will be skipped.", _
vbYesNo + vbQuestion, Title) <> vbYes Then
GoTo ExitHere
End If
End If

Application.ScreenUpdating = False
'Insert the changes into Database

'Create and open a connection string
MyConnObj.ConnectionString = "Provider = sqloledb;" & _
"Data Source=121.247.113.94;" & _
"Initial Catalog=EDocument;" & _
"User ID=sa;" & _
"Password=k24ski;"

MyConnObj.Open
Dim objCmd As New ADODB.Command
Set objCmd.ActiveConnection = MyConnObj
objCmd.CommandTimeout = MyConnObj.CommandTimeout

If oDoc.Tables.Count > 0 Then
Dim tableCount
tableCount = oDoc.Tables.Count
MsgBox ("No of Tables:" & tableCount)
End If

Dim inc As Integer
inc = 1
While inc <> oDoc.Tables.Count
MsgBox ("Table Name:" & oDoc.Tables(inc).ID)
inc = inc + 1
Wend


For Each oRevision In oDoc.Revisions
Select Case oRevision.Type
Case wdDeleteCellsEntireColumn, wdDeleteCellsEntireRow,
wdRevisionInsert, wdRevisionDelete, wdRevisionTableProperty,
wdRevisionCellDeletion, wdRevisionCellInsertion, wdRevisionCellMerge,
wdCommentsStory, wdRevisionProperty, wdRevisionsViewFinal
With oRevision

strText = .Range.Text

Set oRange = .Range
Do While InStr(1, oRange.Text, VBA.Chr(2)) > 0
'Find each Chr(2) in strText and replace by
appropriate text
i = InStr(1, strText, VBA.Chr(2))

If oRange.Footnotes.Count = 1 Then
strText = Replace(Expression:=strText, _
Find:=VBA.Chr(2), Replace:="[footnote
reference]", _
Start:=1, Count:=1)
'To keep track of replace, adjust oRange to
start after i
oRange.Start = oRange.Start + i

ElseIf oRange.Endnotes.Count = 1 Then
strText = Replace(Expression:=strText, _
Find:=VBA.Chr(2), Replace:="[endnote
reference]", _
Start:=1, Count:=1)
'To keep track of replace, adjust oRange to
start after i
oRange.Start = oRange.Start + i
End If
Loop
End With
'Add 1 to counter
n = n + 1

'Type of revision
If oRevision.Type = wdRevisionInsert Then
ChangeType = "DataInserted"
ElseIf oRevision.Type = wdRevisionDelete Then
ChangeType = "DataDeleted"
ElseIf oRevision.Type = wdRevisionTableProperty Then
ChangeType = "Table"

ElseIf oRevision.Type = wdRevisionCellDeletion Then
ChangeType = "Table Cell Delete"

ElseIf oRevision.Type = wdRevisionCellInsertion Then
ChangeType = "Table Cell Insert"

ElseIf oRevision.Type = wdRevisionCellMerge Then
ChangeType = "Table Cell Merge"


ElseIf oRevision.Type = wdCommentsStory Then
ChangeType = "Comments Insert"
End If

strSQL = "INSERT INTO TrackChanges (PageNo,PLineNo, CType,
DataChanged, Author, ChangeDate) " _
& "VALUES (" &
oRevision.Range.Information(wdActiveEndPageNumber) & "," &
oRevision.Range.Information(wdFirstCharacterLineNumber) & ",'" & ChangeType &
"','" & strText & "','" & oRevision.Author & "'," &
VBA.Format(oRevision.Date, "mm-dd-yyyy") & ")"
'Execute the query
'MsgBox strSQL
Dim dummy, dt
dt = Now()
dummy = VBA.Format(dt, "dd/mm/yyyy")
objCmd.CommandText = strSQL
objCmd.CommandType = adCmdText ' passthrough
objCmd.Execute


End Select
Next oRevision

Dim imageCount, imagename
imageCount = 0

For Each iShape In ActiveDocument.InlineShapes
imageCount = imageCount + 1
'Set aRange = oDoc.InlineShapes(imageCount).Range
imagename = iShape.AlternativeText
MsgBox "Name of the Image-" & imageCount & "in the
Document::" & imagename
Next iShape

MsgBox "Total Number of Images in the Document are ::" & imageCount

If n = 0 Then
MsgBox "No insertions or deletions were found.", vbOKOnly, Title
oNewDoc.Close savechanges:=wdDoNotSaveChanges
GoTo ExitHere
End If

Application.ScreenUpdating = True
Application.ScreenRefresh

MsgBox n & " tracked changes have been extracted. " & _
"Saved information in to Database.", vbOKOnly, Title


ExitHere:
Set oDoc = Nothing
Set oNewDoc = Nothing
Set oTable = Nothing
Set oRow = Nothing
Set oRange = Nothing

End Sub