via vba code injectie , vba code wijzigen, wissen, aanpassen, in meerdere bestaande excel files

Stel, je hebt in een map, 30 excel bestanden met macro’s, waarin je vba code wil toevoegen aan het werkblad (thisworkbook) en je wil ook vba code toevoegen aan een module.

Het is mogelijk, om de code via een vba sub , bij alle 30 tegelijk te wijzigen, aanpassen, wissen……

Opgelet, misbruik deze code niet om een virus te schrijven.

Hoe is het opgebouwd : de sub powervba(), gaat alle xlsm files openen die in de map c:\test staan, hij start eerst de sub removecode, en dan de sub om eventprocedure aan te maken.

Sub powervba()
Dim directory As String, FileName As String, sheet As Worksheet, i As Integer, j As Integer, wacht As String

Application.ScreenUpdating = False
directory = “c:\test\”
FileName = Dir(directory & “*.xlsm”)

Do While FileName <> “”
Workbooks.Open (directory & FileName)
i = i + 1
desecure
‘Workbooks.Save (directory & fileName)
Workbooks(FileName).Close SaveChanges:=True
Cells(i, 2).Value = FileName
FileName = Dir()
Loop
End Sub

Sub desecure()
Application.Visible = True
RemoveCode
CreateEventProcedure
End Sub

Sub AddProcedure()

Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = “””” ‘ one ” character

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(“dkmod”)
Set CodeMod = VBComp.CodeModule

With CodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, “Public Sub SayHello()”
LineNum = LineNum + 1
.InsertLines LineNum, “dim wacht as string ”
LineNum = LineNum + 1
.InsertLines LineNum, “wacht=inputbox (” & DQUOTE & “geef wachtwoord” & DQUOTE & “)”
LineNum = LineNum + 1
.InsertLines LineNum, “if wacht<> ” & DQUOTE & “1234” & DQUOTE & “then”
LineNum = LineNum + 1
.InsertLines LineNum, ”    activeworkbook.close ”
LineNum = LineNum + 1
.InsertLines LineNum, “end if ”

.InsertLines LineNum, “End Sub”
End With

End Sub

Sub CreateEventProcedure()  ‘hier maak je bij thisworkbook, bij open de code aan
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = “””” ‘ one ” character

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents(“ThisWorkbook”)
Set CodeMod = VBComp.CodeModule

With CodeMod
LineNum = .CreateEventProc(“Open”, “Workbook”)
LineNum = LineNum + 1
.InsertLines LineNum, “dim wacht as string ”
LineNum = LineNum + 1
.InsertLines LineNum, “wacht=inputbox (” & DQUOTE & “geef wachtwoord” & DQUOTE & “)”
LineNum = LineNum + 1
.InsertLines LineNum, “if wacht<> ” & DQUOTE & “1234” & DQUOTE & “then”
LineNum = LineNum + 1
.InsertLines LineNum, ”    activeworkbook.close ”
LineNum = LineNum + 1
.InsertLines LineNum, “end if ”
End With
End Sub

Sub RemoveCode()
‘Remove all code from ThisWorkbook code module
ThisWorkbook.VBProject.VBComponents(“ThisWorkbook”).CodeModule.DeleteLines 1, _
ThisWorkbook.VBProject.VBComponents(“ThisWorkbook”).CodeModule.CountOfLines
ActiveWorkbook.VBProject.VBComponents(“ThisWorkbook”).CodeModule.DeleteLines 1, _
ActiveWorkbook.VBProject.VBComponents(“ThisWorkbook”).CodeModule.CountOfLines

End Sub

 

   

Geef een reactie

Het e-mailadres wordt niet gepubliceerd. Vereiste velden zijn gemarkeerd met *

  • Zoek de Ict tips

    Generic selectors
    Exact matches only
    Search in title
    Search in content
    Search in posts
    Search in pages
    Filter by Categories
    advies desktop
    advies notebook
    advies smart tv
    cloning and backup
    cmd
    esxi
    exchange 2007/2010/2013
    freeware
    koopadvies
    office 2003
    office 2007
    office 2010
    office 2013
    office 2016
    Powershell
    Thin os (wyse)
    tips voorblad
    Uncategorized
    Visual Basic For Applications (VBA)
    vmware
    win 8 apps zeer goed
    Windows 10
    windows 7
    Windows 8
    windows 8.1
    Windows 8.x RT
    windows server 2003
    windows server 2008
    windows server 2012
    windows server 2012 R2
    windows server 2016
    wordpress