Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 09-12-2018, 01:06 PM
alzasp alzasp is offline Windows 10 Office 2016
Novice
 
Join Date: Sep 2018
Posts: 2
alzasp is on a distinguished road
Default Exporting tracked changes to excel

Is there a macro I can use that exports the tracked changes, inserts and deletes, to excel? I have a macro (below) that exports the comments but it does not extract the tracked changes.



Code:
Sub CopyCommentsToExcel()
 'Create in Word vba
 Dim xlApp As Object
 Dim xlWB As Object
 Dim i As Integer
     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err Then
         Set xlApp = CreateObject("Excel.Application")
     End If
     On Error GoTo 0
     xlApp.Visible = True
     Set xlWB = xlApp.Workbooks.Add        ' create a new workbook
     With xlWB.Worksheets(1)
     ' Create Heading
        HeadingRow = 1
        .Cells(HeadingRow, 1).Formula = "ITEM NO."
        .Cells(HeadingRow, 2).Formula = "PAGE"
        .Cells(HeadingRow, 3).Formula = "REVIEWER"
        .Cells(HeadingRow, 4).Formula = "COMMENT"
        .Cells(HeadingRow, 5).Formula = "DATE"
        
         For i = 1 To ActiveDocument.Comments.Count
             .Cells(i + HeadingRow, 1).Formula = ActiveDocument.Comments(i).Index
             .Cells(i + HeadingRow, 2).Formula = ActiveDocument.Comments(i).Reference.Information(wdActiveEndAdjustedPageNumber)
             .Cells(i + HeadingRow, 3).Formula = ActiveDocument.Comments(i).Author
             .Cells(i + HeadingRow, 4).Formula = ActiveDocument.Comments(i).Range
             .Cells(i + HeadingRow, 5).Formula = Format(ActiveDocument.Comments(i).Date, "dd/MM/yyyy")
             .Cells(i + HeadingRow, 6).Formula = ActiveDocument.Comments(i).Range.ListFormat.ListString
         Next i
     End With
     Set xlWB = Nothing
     Set xlApp = Nothing
 End Sub

Last edited by macropod; 09-12-2018 at 02:27 PM. Reason: Added code tags & formatting
Reply With Quote
  #2  
Old 09-12-2018, 02:32 PM
macropod's Avatar
macropod macropod is online now Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,199
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

The following macro exports Track-Changes Data for all story ranges in the active document to a new Excel workbook. Tabs are output as <TAB>, manual line breaks are output as <LF> and paragraph breaks are output as <CR>. Field braces are replaced with ordinary braces and, if the revision is in a table cell, the cell address is reported in the form of '* A1 *'. Changes to Footnote & Endnote separators, continuation separators & continuation notices are ignored.
Code:
Sub ExportRevisions()
'Note: A VBA Reference to Excel is required, via Tools|References
Dim Rng As Range, StrRev As String, StrTmp As String, i As Long, j As Long
Dim xlApp As New Excel.Application, xlWkBk As Excel.Workbook, SBar As Boolean
' Store current Status Bar status, then switch on
SBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
' Turn Off Screen Updating
Application.ScreenUpdating = False
StrRev = "Location,Author,Date & Time,Delete,Insert,From,To,Replace,Style,Other"
StrRev = Replace(StrRev, ",", vbTab)
With ActiveDocument
  For Each Rng In .StoryRanges
    With Rng
      ' Process the Revisions
      For i = 1 To .Revisions.Count
        StatusBar = "Analysing Revision " & i
        If i Mod 100 = 0 Then DoEvents
        With .Revisions(i)
          Select Case Rng.StoryType
            Case wdEvenPagesFooterStory
              StrRev = StrRev & vbCr & "Section " & .Range.Sections(1).Index & _
                " EvenPagesFooter" & vbTab & .Author & vbTab & .Date & vbTab
            Case wdFirstPageFooterStory
              StrRev = StrRev & vbCr & "Section " & .Range.Sections(1).Index & _
                " FirstPageFooter" & vbTab & .Author & vbTab & .Date & vbTab
            Case wdPrimaryFooterStory
              StrRev = StrRev & vbCr & "Section " & .Range.Sections(1).Index & _
                " PrimaryFooter" & vbTab & .Author & vbTab & .Date & vbTab
            Case wdEvenPagesHeaderStory
              StrRev = StrRev & vbCr & "Section " & .Range.Sections(1).Index & _
                " EvenPagesHeader" & vbTab & .Author & vbTab & .Date & vbTab
            Case wdFirstPageHeaderStory
              StrRev = StrRev & vbCr & "Section " & .Range.Sections(1).Index & _
                " FirstPageHeader" & vbTab & .Author & vbTab & .Date & vbTab
            Case wdPrimaryHeaderStory
              StrRev = StrRev & vbCr & "Section " & .Range.Sections(1).Index & _
                " PrimaryHeaderStory" & vbTab & .Author & vbTab & .Date & vbTab
            Case wdEndnotesStory
              StrRev = StrRev & vbCr & "Section " & .Range.Sections(1).Index & _
                "Endnote: " & .Range.Endnotes(1).Reference.Text & vbTab & .Author & vbTab & .Date & vbTab
            Case wdFootnotesStory
              StrRev = StrRev & vbCr & "Section " & .Range.Sections(1).Index & _
                "Footnote: " & .Range.Footnotes(1).Reference.Text & vbTab & .Author & vbTab & .Date & vbTab
            Case wdCommentsStory
              StrRev = StrRev & vbCr & "Section " & .Range.Sections(1).Index & _
                "Comment: " & .Range.Comments(1).Index & vbTab & .Author & vbTab & .Date & vbTab
            Case wdEndnoteContinuationNoticeStory, wdEndnoteContinuationSeparatorStory, wdEndnoteSeparatorStory
              StrRev = StrRev & vbCr & vbTab & .Author & vbTab & .Date & vbTab
            Case wdFootnoteContinuationNoticeStory, wdFootnoteContinuationSeparatorStory, wdFootnoteSeparatorStory
              StrRev = StrRev & vbCr & vbTab & .Author & vbTab & .Date & vbTab
            Case wdMainTextStory, wdTextFrameStory
              StrRev = StrRev & vbCr & "Page: " & .Range.Information(wdActiveEndAdjustedPageNumber) & vbTab & .Author & vbTab & .Date & vbTab
          End Select
          Select Case .Type
            Case wdRevisionDelete
              StrRev = StrRev & TidyText(.Range.Text)
              With .Range
                If .Information(wdWithInTable) Then StrRev = StrRev & " * in cell " & ColAddr(.Cells(1).ColumnIndex) & .Cells(1).RowIndex & " *"
              End With
            Case wdRevisionInsert
              StrRev = StrRev & TidyText(.Range.Text)
              With .Range
                If .Information(wdWithInTable) Then StrRev = StrRev & " * in cell " & ColAddr(.Cells(1).ColumnIndex) & .Cells(1).RowIndex & " *"
              End With
            Case wdRevisionMovedFrom
              StrRev = StrRev & TidyText(.Range.Text)
              With .Range
                If .Information(wdWithInTable) Then StrRev = StrRev & " * in cell " & ColAddr(.Cells(1).ColumnIndex) & .Cells(1).RowIndex & " *"
              End With
            Case wdRevisionMovedTo
              StrRev = StrRev & TidyText(.Range.Text)
              With .Range
                If .Information(wdWithInTable) Then StrRev = StrRev & " * in cell " & ColAddr(.Cells(1).ColumnIndex) & .Cells(1).RowIndex & " *"
              End With
            Case wdRevisionReplace
              StrRev = StrRev & TidyText(.Range.Text)
              With .Range
                If .Information(wdWithInTable) Then StrRev = StrRev & " * in cell " & ColAddr(.Cells(1).ColumnIndex) & .Cells(1).RowIndex & " *"
              End With
            Case wdRevisionStyle
              StrRev = StrRev & TidyText(.Range.Text)
              With .Range
                If .Information(wdWithInTable) Then StrRev = StrRev & " * in cell " & ColAddr(.Cells(1).ColumnIndex) & .Cells(1).RowIndex & " *"
              End With
            Case Else
              StrRev = StrRev & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & "Other"
              With .Range
                If .Information(wdWithInTable) Then StrRev = StrRev & " * in cell " & ColAddr(.Cells(1).ColumnIndex) & .Cells(1).RowIndex & " *"
              End With
          End Select
        End With
      Next
    End With
  Next
End With
With xlApp
  .Visible = True
  .DisplayStatusBar = True
  .ScreenUpdating = False
  Set xlWkBk = .Workbooks.Add
  ' Update the workbook.
  With xlWkBk.Worksheets(1)
    For i = 0 To UBound(Split(StrRev, vbCr))
      xlApp.StatusBar = "Exporting Revision " & i
      StrTmp = Split(StrRev, vbCr)(i)
        For j = 0 To UBound(Split(StrTmp, vbTab))
          .Cells(i + 1, j + 1).Value = Split(StrTmp, vbTab)(j)
        Next
    Next
    .Columns("A:C").AutoFit
  End With
  .StatusBar = False
  .DisplayStatusBar = SBar
  .ScreenUpdating = True
  ' Tell the user we're done.
  MsgBox "Workbook updates finished.", vbOKOnly
End With
' Release object memory
Set xlWkBk = Nothing: Set xlApp = Nothing
' Clear the Status Bar
Application.StatusBar = False
' Restore original Status Bar status
Application.DisplayStatusBar = SBar
' Restore Screen Updating
Application.ScreenUpdating = True
End Sub

Function TidyText(StrTxt As String)
TidyText = Replace(Replace(Replace(Replace(Replace(StrTxt, vbTab, "<TAB>"), vbCr, "<CR>"), Chr(11), "<LF>"), Chr(19), "{"), Chr(21), "}")
End Function

Function ColAddr(i As Long) As String
If i > 26 Then
  ColAddr = Chr(64 + Int(i / 26)) & Chr(64 + (i Mod 26))
Else
  ColAddr = Chr(64 + i)
End If
End Function
To limit processing to just the body of the document, delete:
Code:
  For Each Rng In .StoryRanges
    With Rng
and the corresponding:
Code:
    End With
  Next
PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #3  
Old 09-13-2018, 05:22 AM
alzasp alzasp is offline Windows 10 Office 2016
Novice
 
Join Date: Sep 2018
Posts: 2
alzasp is on a distinguished road
Default

When I run the macro I get this error and it highlights the red bold code below. Any thoughts on how the fix this?

"Compile error:
"User-defined type not defined"


Sub ExportRevisions()
'Note: A VBA Reference to Excel is required, via Tools|References
Dim Rng As Range, StrRev As String, StrTmp As String, i As Long, j As Long
Dim xlApp As New excel.Application, xlWkBk As excel.Workbook, SBar As Boolean
' Store current Status Bar status, then switch on
SBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
' Turn Off Screen Updating
Application.ScreenUpdating = False
StrRev = "Location,Author,Date & Time,Delete,Insert,From,To,Replace,Style,Other"
StrRev = Replace(StrRev, ",", vbTab)
With ActiveDocument
For Each Rng In .StoryRanges
With Rng
' Process the Revisions
For i = 1 To .Revisions.Count
StatusBar = "Analysing Revision " & i
If i Mod 100 = 0 Then DoEvents
With .Revisions(i)
Reply With Quote
  #4  
Old 09-13-2018, 02:40 PM
macropod's Avatar
macropod macropod is online now Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,199
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Did you read the first line of the code and do as advised?
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #5  
Old 11-13-2018, 10:41 AM
earnold517 earnold517 is offline Windows 10 Office 2016
Novice
 
Join Date: Nov 2018
Posts: 1
earnold517 is on a distinguished road
Default refine the code and minor issues

Hello, this is a wonderful code. I am new to learning how to do all the VBA tricks and have a few questions.

When I use the code below it puts all of the changes in to the DELETE column. I found a similar code that looks almost the same and it uses a <vbtab> to move the comments in to the different columns, but because they are set up different I can not figure out how to combine them.

I also found a code the at extracts the comments as well but the extracting of the paragraph header and title doesn't work. Similar to the first example in this thread.

And one for the changes in the images. I would like to have all these functions in one code.

Is there a way to have the page numbers listed with the preface pages ie. numbered i, ii, ii etc.

The goal is I have multiple users contribution to a master document that goes through an update every year and instead of gathering change suggestions comments in excel, then manually making the changes in word, I'd like for the contributors to make the changes, and provide comments directly in word and then i can pull the author, tracked changes, image changes, comments and there specific location out to a tracker. Then with minor manipulation of the tracker i could have it submitted as a formal document of changes to the revision of the document.

Thank you again for any help.
Reply With Quote
  #6  
Old 11-13-2018, 01:34 PM
macropod's Avatar
macropod macropod is online now Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,199
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

The macro in post #2 puts Deletion, Insertion, Move From , Move To, Replace, Style, & Other revisions into separate columns. The 'similar code that looks almost the same' you refer to, plus the 'code the at extracts the comments as well' are most likely code I posted @ https://answers.microsoft.com/en-us/...f-8dc609cc75af - though you may have found it elsewhere, too.
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
  #7  
Old 12-29-2018, 10:04 PM
macropod's Avatar
macropod macropod is online now Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 19,199
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Cross-posted at: https://www.excelforum.com/excel-pro...-to-excel.html

For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184
__________________
Cheers,
Paul Edstein
[MS MVP - Word]
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Exporting data to an excel template Stevie23 Excel Programming 3 04-05-2018 12:12 AM
Exporting Messages to Excel using VBA paul h Outlook 6 07-22-2016 06:37 AM
Exporting to Excel in MSP c991257 Project 7 05-15-2016 07:58 AM
Exporting Contacts to Excel misslinds Outlook 1 06-15-2014 08:08 AM
Exporting to Excel lhicks Outlook 1 07-13-2011 02:02 PM


All times are GMT -7. The time now is 07:38 PM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft