[Winmerge-svn] SF.net SVN: winmerge: [5117] trunk/Plugins/src_VB/CompareMSWordFiles/ WinMergeScript.cls

[<ge...@us...>]

Revision: 5117
          http://winmerge.svn.sourceforge.net/winmerge/?rev=5117&view=rev
Author:   gerundt
Date:     2008-03-03 14:39:01 -0800 (Mon, 03 Mar 2008)

Log Message:
-----------
PATCH: [ 1510298 ] MS Word - compare macros, bookmarks, document properties etc - Add function GetMacrosHead()

Modified Paths:
--------------
    trunk/Plugins/src_VB/CompareMSWordFiles/WinMergeScript.cls

Modified: trunk/Plugins/src_VB/CompareMSWordFiles/WinMergeScript.cls
===================================================================
--- trunk/Plugins/src_VB/CompareMSWordFiles/WinMergeScript.cls	2008-03-03 22:14:04 UTC (rev 5116)
+++ trunk/Plugins/src_VB/CompareMSWordFiles/WinMergeScript.cls	2008-03-03 22:39:01 UTC (rev 5117)
@@ -65,6 +65,33 @@
     LastErrorString = myLastErrorString
 End Property
 
+Private Function GetMacrosHead(objDoc As Object) As String
+    Dim oTextToSave As String
+    
+    On Error GoTo NoMacrosHead
+    
+    oTextToSave = ""
+    If Not objDoc.VBProject Is Nothing Then
+        oTextToSave = oTextToSave & "The VB Project Name is " & objDoc.VBProject.Name & vbCrLf
+        If Not objDoc.VBProject.VBComponents Is Nothing Then
+            oTextToSave = oTextToSave & "There are " & objDoc.VBProject.VBComponents.Count & _
+                " Microsoft Word macros in this document." & vbCrLf
+        End If
+    End If
+    GetMacrosHead = oTextToSave
+    Exit Function
+    
+NoMacrosHead:
+    If Err = -2147188160 Or Err = -2146822220 Or Err = 6068 Then
+        oTextToSave = "Cannot get Macros." & vbCrLf & _
+            "   To allow WinMerge to compare macros, use MS Office to alter the settings in the Macro Security for the current application." & vbCrLf & _
+            "   The Trust access to Visual Basic Project feature should be turned on to use this feature in WinMerge." & vbCrLf
+    Else
+        oTextToSave = oTextToSave & "There are no Microsoft Word macros in this document." & vbCrLf
+    End If
+    GetMacrosHead = oTextToSave
+End Function
+
 Public Function UnpackFile(fileSrc As String, fileDst As String, ByRef bChanged As Boolean, ByRef subcode As Long) As Boolean
     On Error GoTo CleanUp
     
@@ -79,10 +106,28 @@
     Dim objDoc As Object
     Set objDoc = objWD.Documents.Open(fileSrc)
 
+    Dim oTextToSave As String
+    
+    On Error Resume Next
+    
+    oTextToSave = oTextToSave & "Document Properties" & vbCrLf
+    oTextToSave = oTextToSave & GetMacrosHead(objDoc)
+    
+    Dim hFile As Long
+    
+    oTextToSave = oTextToSave & vbCrLf
+    
     ' Save the text content of the document
-    Open fileDst For Output Shared As #1
-    Print #1, objDoc.Content.Text
-    Close #1
+    oTextToSave = oTextToSave & objDoc.Content.Text & vbCrLf
+
+    ' Save the collected text
+    hFile = FreeFile
+    Open fileDst For Output Shared As #hFile
+    Print #hFile, oTextToSave
+    Close #hFile
+
+    ' Close the document without saving changes
+    objDoc.Close False
     
     bChanged = True
     UnpackFile = True


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.