Makros und deren Eigenschaften auslesen

1 1 1 1 1 1 1 1 1 1 Rating 0.00 (0 Votes)

Details: Kategorie: Codeschnipsel DB Objekte; Geschrieben von TommyK; Zugriffe: 6102

Problemstellung:

Für 32Bit und 64Bit Office Versionen

Wie kann ich die Makros und deren Eigenschaften auslesen?
Auch wenn Makros buggy sind kann es doch mal vorkommen
das man diese zu Dokumentationszwecken auslesen will.

Ich habe mal 2 Lösungen vorbereitet.

1. Für jedes Makro wird eine eigene Textdatei geschrieben.

Private Sub Read_Makros1(sPath As String)
    Dim obj As Object
    Dim db As DAO.Database
    Dim FileName As String
     Set db = CurrentDb
    For Each obj In db.Containers("Scripts").Documents
        FileName = sPath & obj.Name & ".txt"
        Application.SaveAsText acMacro, obj.Name, FileName
    Next obj
End Sub

Aufruf z.B.:

Read_Makros1 "H:\Dokumente\Access\"

Ergebnis:

2. Alle Makros werden in eine Textdatei geschrieben.

Private Sub Read_Makros2(sPath As String)
    Dim sMacroTXT As String
    Dim sTmpFileName As String
    Dim objMacro As Object
    Dim db As DAO.Database
    Dim fso, fsoMakroFile, TempFolder
    Const TemporaryFolder = 2
    sMacroTXT = sPath & "DBMakros.txt"
    Set db = CurrentDb
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set TempFolder = fso.GetSpecialFolder(TemporaryFolder)
    sTmpFileName = TempFolder & "\" & fso.GetTempName
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set TempFolder = fso.GetSpecialFolder(TemporaryFolder)
    Set fsoMakroFile = fso.OpenTextFile(sMacroTXT, 2, True)
    fsoMakroFile.WriteLine "Alle Makros der Datenbank"
    For Each objMacro In db.Containers("Scripts").Documents
        fsoMakroFile.WriteBlankLines (1)
        fsoMakroFile.WriteLine "'Makro: " & objMacro.Name
        fsoMakroFile.WriteBlankLines (1)
        Application.SaveAsText acMacro, objMacro.Name, sTmpFileName
        fsoMakroFile.Write fso.OpenTextFile(sTmpFileName, 1).ReadAll
        fso.DeleteFile sTmpFileName
    Next objMacro
    fsoMakroFile.Close: Set fsoMakroFile = Nothing
    Set fso = Nothing
    db.Close: Set db = Nothing
End Sub

Aufruf z.B.:

Read_Makros2 "H:\Dokumente\Access\"

Ergebnis: