Export MS Access-Formulare und-Klasse / Modules Rekursiv auf text-Dateien?

Fand ich einige code, der auf eine alte-message-board-schön, dass alle Exporte von VBA-code von Klassen, Module und Formulare (siehe unten):

Option Explicit
Option Compare Database
Function SaveToFile()                  'Save the code for all modules to files in currentDatabaseDir\Code

Dim Name As String
Dim WasOpen As Boolean
Dim Last As Integer
Dim I As Integer
Dim TopDir As String, Path As String, FileName As String
Dim F As Long                          'File for saving code
Dim LineCount As Long                  'Line count of current module

I = InStrRev(CurrentDb.Name, "\")
TopDir = VBA.Left(CurrentDb.Name, I - 1)
Path = TopDir & "\" & "Code"           'Path where the files will be written

If (Dir(Path, vbDirectory) = "") Then
  MkDir Path                           'Ensure this exists
End If

'--- SAVE THE STANDARD MODULES CODE ---

Last = Application.CurrentProject.AllModules.Count - 1

For I = 0 To Last
  Name = CurrentProject.AllModules(I).Name
  WasOpen = True                       'Assume already open

  If Not CurrentProject.AllModules(I).IsLoaded Then
    WasOpen = False                    'Not currently open
    DoCmd.OpenModule Name              'So open it
  End If

  LineCount = Access.Modules(Name).CountOfLines
  FileName = Path & "\" & Name & ".vba"

  If (Dir(FileName) <> "") Then
    Kill FileName                      'Delete previous version
  End If

  'Save current version
  F = FreeFile
  Open FileName For Output Access Write As #F
  Print #F, Access.Modules(Name).Lines(1, LineCount)
  Close #F

  If Not WasOpen Then
    DoCmd.Close acModule, Name         'It wasn't open, so close it again
  End If
Next

'--- SAVE FORMS MODULES CODE ---

Last = Application.CurrentProject.AllForms.Count - 1

For I = 0 To Last
  Name = CurrentProject.AllForms(I).Name
  WasOpen = True

  If Not CurrentProject.AllForms(I).IsLoaded Then
    WasOpen = False
    DoCmd.OpenForm Name, acDesign
  End If

  LineCount = Access.Forms(Name).Module.CountOfLines
  FileName = Path & "\" & Name & ".vba"

  If (Dir(FileName) <> "") Then
    Kill FileName
  End If

  F = FreeFile
  Open FileName For Output Access Write As #F
  Print #F, Access.Forms(Name).Module.Lines(1, LineCount)
  Close #F

  If Not WasOpen Then
    DoCmd.Close acForm, Name
  End If
Next
MsgBox "Created source files in " & Path
End Function

Dieser code jedoch nicht mein problem lösen, da habe ich 110 ms-access *.mdb's, die ich brauche zu exportieren, die von vba in Textdateien geeignet für grepping.

Die Pfade zu den 110-Dateien, die ich bin daran interessiert, sind bereits in einer Tabelle gespeichert, und mein code bereits gewonnene Informationen rekursiv (zusammen mit einigen anderen filtern)...so ist der rekursive Teil ist getan.

Meisten dieser Dateien geöffnet sind, durch eine einzelne Benutzer-security-Datei, eine .mdw und ich habe versucht, verschiedene Methoden, Sie zu öffnen. ADO-und ADOX hat Super geklappt, wenn ich war auf der Suche für verknüpfte Tabellen in diesen Verzeichnissen...aber der obige code beinhaltet in der Datenbank, die Sie exportieren die Daten ausund ich möchte in der Lage sein, dies zu tun aus einer separaten Datenbank, öffnet alle mdbs und führt den export auf jeden von Ihnen.

Einer meiner versuche an dieser beteiligt mit der PrivDBEngine-Klasse eine Verbindung zu den Datenbanken extern, aber es mir nicht erlaubt, Zugriff auf das Application-Objekt das ist, was die export-code oben erfordert.

Private Sub exportToFile(db_path As String, db_id As String, loginInfo As AuthInfoz, errFile As Variant)

    Dim pdbeNew As PrivDBEngine
    Dim db As DAO.Database
    Dim ws As DAO.Workspace
    Dim rst As DAO.Recordset

    Dim cn As ADODB.Connection ' ADODB.Connection
    Dim rs As ADODB.Recordset ' ADODB.Recordset
    Dim strConnect As String
    Dim blnReturn As Boolean

    Dim Doc              As Document
    Dim mdl              As Module
    Dim lngCount         As Long
    Dim strForm          As String
    Dim strOneLine       As String
    Dim sPtr             As Integer

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set exportFile = fso.CreateTextFile("E:\Tickets\CSN1006218\vbacode\" & db_id & ".txt", ForAppending)

    ' Export stuff...

    On Error GoTo errorOut

    Set pdbeNew = New PrivDBEngine
    With pdbeNew
        .SystemDB = loginInfo.workgroup
        .DefaultUser = loginInfo.username
        .DefaultPassword = loginInfo.password
    End With


    Set ws = pdbeNew.Workspaces(0)


    Set db = ws.OpenDatabase(db_path)

    For Each Doc In db.Containers("Modules").Documents
        DoCmd.OpenModule Doc.Name
        Set mdl = Modules(Doc.Name)

        exportFile.WriteLine ("---------------------")
        exportFile.WriteLine ("Module Name: " & Doc.Name)
        exportFile.WriteLine ("Module Type: " & mdl.Type)
        exportFile.WriteLine ("---------------------")

        lngCount = lngCount + mdl.CountOfLines

        'For i = 1 To lngCount
        '    strOneLine = mdl.Lines(i, 1)
        '    exportFile.WriteLine (strOneLine)
        'Next i

        Set mdl = Nothing
        DoCmd.Close acModule, Doc.Name
    Next Doc

Close_n_exit:

    If Not (db Is Nothing) Then
        Call wk.Close
        Set wk = Nothing
        Call db.Close
    End If



    Call exportFile.Close
    Set exportFile = Nothing
    Set fso = Nothing

    Exit Sub

errorOut:
    Debug.Print "----------------"
    Debug.Print "BEGIN: Err"
    If err.Number <> 0 Then
        Msg = "Error # " & Str(err.Number) & " was generated by " _
         & err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & err.Description
        'MsgBox Msg, , "Error", err.HelpFile, err.HelpContext
        Debug.Print Msg
    End If
    Resume Close_n_exit

End Sub

Gibt es trotzdem, um den Zugriff auf die application Objekt aus einem PrivDBEngine? Ich habe eine Menge von Modulen, die müssen grepping.

InformationsquelleAutor der Frage leeand00 | 2013-06-05

Können Sie auch versuchen, diesen code. Es wird die Erhaltung der posten' Dateitypen (.bas, .cls, .frm)
Erinnern zu entnehmen /Überprüfen Sie die Microsoft Visual Basic Für Applications Extensibility Bibliothek in
VBE - > Tools > Referenzen

Public Sub ExportAllCode()

    Dim c As VBComponent
    Dim Sfx As String

    For Each c In Application.VBE.VBProjects(1).VBComponents
        Select Case c.Type
            Case vbext_ct_ClassModule, vbext_ct_Document
                Sfx = ".cls"
            Case vbext_ct_MSForm
                Sfx = ".frm"
            Case vbext_ct_StdModule
                Sfx = ".bas"
            Case Else
                Sfx = ""
        End Select

        If Sfx <> "" Then
            c.Export _
                Filename:=CurrentProject.Path & "\" & _
                c.Name & Sfx
        End If
    Next c

End Sub

InformationsquelleAutor der Antwort Đức Thanh Nguyễn

Können Sie den Zugang.Application-Objekt.

Auch, um zu vermeiden, dass mehrere bestätigungsdialogfelder, die beim öffnen der Datenbanken, nur ändern Sie die Sicherheitsstufe unter Extras /Makros /Sicherheit.

Und zu öffnen mehrere Datenbanken mit Benutzer/Passwort können Sie sich in die Arbeitsgruppe (Extras /Sicherheit /Arbeitsgruppenadministrator) und melde dich mit dem gewünschten Benutzer/Kennwort (aus der Datenbank mit der SaveToFile-Funktion), dann den code ausführen. Denken Sie daran, später auf, um sich dem Standard-Arbeitsgruppe (Sie können versuchen, um sich einer nicht existierenden Arbeitsgruppe und der Zugriff wird wieder auf die Standardeinstellung).

Option Explicit
Option Compare Database


'Save the code for all modules to files in currentDatabaseDir\Code
Public Function SaveToFile()

   On Error GoTo SaveToFile_Err

   Dim Name As String
   Dim WasOpen As Boolean
   Dim Last As Integer
   Dim i As Integer
   Dim TopDir As String, Path As String, FileName As String
   Dim F As Long                          'File for saving code
   Dim LineCount As Long                  'Line count of current module

   Dim oApp As New Access.Application

   ' Open remote database
   oApp.OpenCurrentDatabase ("D:\Access\myDatabase.mdb"), False


   i = InStrRev(oApp.CurrentDb.Name, "\")
   TopDir = VBA.Left(oApp.CurrentDb.Name, i - 1)
   Path = TopDir & "\" & "Code"           'Path where the files will be written

   If (Dir(Path, vbDirectory) = "") Then
      MkDir Path                           'Ensure this exists
   End If

   '--- SAVE THE STANDARD MODULES CODE ---

   Last = oApp.CurrentProject.AllModules.Count - 1

   For i = 0 To Last
      Name = oApp.CurrentProject.AllModules(i).Name
      WasOpen = True                       'Assume already open

         If Not oApp.CurrentProject.AllModules(i).IsLoaded Then
            WasOpen = False                    'Not currently open
            oApp.DoCmd.OpenModule Name              'So open it
         End If

      LineCount = oApp.Modules(Name).CountOfLines
      FileName = Path & "\" & Name & ".vba"

      If (Dir(FileName) <> "") Then
        Kill FileName                      'Delete previous version
      End If

      'Save current version
      F = FreeFile
      Open FileName For Output Access Write As #F
      Print #F, oApp.Modules(Name).Lines(1, LineCount)
      Close #F

      If Not WasOpen Then
         oApp.DoCmd.Close acModule, Name         'It wasn't open, so close it again
      End If
   Next

   '--- SAVE FORMS MODULES CODE ---

   Last = oApp.CurrentProject.AllForms.Count - 1

   For i = 0 To Last
      Name = oApp.CurrentProject.AllForms(i).Name
      WasOpen = True

      If Not oApp.CurrentProject.AllForms(i).IsLoaded Then
         WasOpen = False
         oApp.DoCmd.OpenForm Name, acDesign
      End If

      LineCount = oApp.Forms(Name).Module.CountOfLines
      FileName = Path & "\" & Name & ".vba"

      If (Dir(FileName) <> "") Then
         Kill FileName
      End If

      F = FreeFile
      Open FileName For Output Access Write As #F
      Print #F, oApp.Forms(Name).Module.Lines(1, LineCount)
      Close #F

      If Not WasOpen Then
         oApp.DoCmd.Close acForm, Name
      End If
   Next

   '--- SAVE REPORTS MODULES CODE ---

   Last = oApp.CurrentProject.AllReports.Count - 1

   For i = 0 To Last
      Name = oApp.CurrentProject.AllReports(i).Name
      WasOpen = True

      If Not oApp.CurrentProject.AllReports(i).IsLoaded Then
         WasOpen = False
         oApp.DoCmd.OpenReport Name, acDesign
      End If

      LineCount = oApp.Reports(Name).Module.CountOfLines
      FileName = Path & "\" & Name & ".vba"

      If (Dir(FileName) <> "") Then
         Kill FileName
      End If

      F = FreeFile
      Open FileName For Output Access Write As #F
      Print #F, oApp.Reports(Name).Module.Lines(1, LineCount)
      Close #F

      If Not WasOpen Then
         oApp.DoCmd.Close acReport, Name
      End If
   Next

   MsgBox "Created source files in " & Path

   ' Reset the security level
   Application.AutomationSecurity = msoAutomationSecurityByUI

SaveToFile_Exit:

   If Not oApp.CurrentDb Is Nothing Then oApp.CloseCurrentDatabase
   If Not oApp Is Nothing Then Set oApp = Nothing
   Exit function

SaveToFile_Err:

   MsgBox ("Error " & Err.Number & vbCrLf & Err.Description)
   Resume SaveToFile_Exit

End Function

Habe ich Hinzugefügt-code für die Berichte, Module. Wenn ich einige Zeit werde ich versuchen, die Umgestaltung des Codes.

Ich finde dies einen tollen Beitrag. Vielen Dank für das teilen.

Hinsichtlich

InformationsquelleAutor der Antwort Clon

Wie für MS Excel, können Sie auch mit einer Schleife über die Application.VBE.VBProjects(1).VBComponents und verwenden Sie die Export Methode zum exportieren der Module/Klassen/Formen:

Const VB_MODULE = 1
Const VB_CLASS = 2
Const VB_FORM = 100
Const EXT_MODULE = ".bas"
Const EXT_CLASS = ".cls"
Const EXT_FORM = ".frm"
Const CODE_FLD = "Code"

Sub ExportAllCode()

Dim fileName As String
Dim exportPath As String
Dim ext As String
Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
' Set export path and ensure its existence
exportPath = CurrentProject.path & "\" & CODE_FLD
If Not FSO.FolderExists(exportPath) Then
    MkDir exportPath
End If

' The loop over all modules/classes/forms
For Each c In Application.VBE.VBProjects(1).VBComponents
    ' Get the filename extension from type
    ext = vbExtFromType(c.Type)
    If ext <> "" Then
        fileName = c.name & ext
        debugPrint "Exporting " & c.name & " to file " & fileName
        ' THE export
        c.Export exportPath & "\" & fileName
    Else
        debugPrint "Unknown VBComponent type: " & c.Type
    End If
Next c

End Sub

' Helper function that translates VBComponent types into file extensions
' Returns an empty string for unknown types
Function vbExtFromType(ByVal ctype As Integer) As String
    Select Case ctype
        Case VB_MODULE
            vbExtFromType = EXT_MODULE
        Case VB_CLASS
            vbExtFromType = EXT_CLASS
        Case VB_FORM
            vbExtFromType = EXT_FORM
    End Select
End Function

Dauert nur einen Bruchteil einer Sekunde ausführen.

Cheers

InformationsquelleAutor der Antwort sebastian

2

Schöne Antwort Clon.

Nur eine leichte variation, wenn Sie versuchen zu öffnen, MDBs, hat eine Startformular und/oder eine AutoExec-makro und oben nicht immer scheinen zuverlässig zu funktionieren.

Blick auf diese Antwort auf einer anderen website: Durch pass-Start-Formular /Makros und Blättern fast an das Ende der Diskussion ist ein code, die vorübergehend entledigt sich der Start-Formular, Einstellungen und extrahiert die AutoExec-makro, um Ihre Datenbank vor dem schreiben über Sie mit einem TempAutoExec makro (die nichts tut), hat einige Arbeit (zwischen den Zeilen 'Read-Befehl bars und app.CloseCurrentDatabase) und dann bringt er alles wieder zurück.

InformationsquelleAutor der Antwort dmc2005
0

ein anderer Weg ist, halten die meisten verwendeten code in eine externe master.mdb
und kommen Sie zu jeder Anzahl von *.mdbs Trog-Module->Tools->Referenzen>Suche->...\master.mdb

das einzige problem der alten Access 97 können Sie Debuggen, Bearbeiten und Speichern Sie direkt im Ziel.mdb,
aber in allen neueren, seit der MA 2000, 'Speichern' option Weg ist und alle Warnungen auf schließen nicht gespeicherte code

InformationsquelleAutor der Antwort MartiniB

IDK warum hat niemand vorgeschlagen, diese vor, aber hier ist ein kleines Stück code, den ich für diesen Einsatz. Ziemlich einfach und unkompliziert

Public Sub VBAExportModule()
    On Error GoTo Errg
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("SELECT MSysObjects.Name FROM MSysObjects WHERE Type=-32761", dbOpenDynaset, dbSeeChanges)

    Do Until rs.EOF
        Application.SaveAsText acModule, rs("Name"), "C:\" & rs("Name") & ".txt"
        rs.MoveNext
    Loop

Cleanup:
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    Exit Sub
Errg:
    GoTo Cleanup
End Sub

InformationsquelleAutor der Antwort Doug Coats

Schreibe einen Kommentar

Du musst angemeldet sein, um einen Kommentar abzugeben.