2013-06-05 86 views
13

znalazłem jakiś kod na starożytnym Forum że ładnie eksportuje wszystkie kodu VBA z klas, modułów i formularzy (patrz poniżej):Eksportowanie formularzy MS Access i klas/modułów rekurencyjnie do plików tekstowych?

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 

Jednak ten kod nie rozwiązuje mojego problemu ponieważ mam 110 ms-access *.mdb 's, które muszę wyeksportować vba z plików tekstowych odpowiednich do grepping.

Ścieżki do 110 plików, które mnie interesują, są już zapisane w tabeli, a mój kod już zdobył tę informację rekurencyjnie (wraz z kilkoma innymi filtrami) ... więc część rekurencyjna została wykonana.

Większość tych plików jest otwieranych przez jeden plik zabezpieczeń użytkownika dostępu, .mdw i próbowałem kilku metod ich otwierania. ADO i ADOX działały wspaniale, gdy szukałem połączonych tabel w tych katalogach ... ale powyższy kod obejmuje being inside the database you are exporting the data from, i chcę móc to zrobić z oddzielnej bazy danych, która otwiera wszystkie mdb s i wykonuje eksport na każda z nich.

Jedna z moich prób polegała na użyciu klasy PrivDBEngine do zewnętrznego połączenia z bazami danych, ale nie pozwala mi uzyskać dostępu do obiektu aplikacji, co jest wymagane przez powyższy kod eksportu.

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 

Czy mimo to uzyskać dostęp do obiektu application z PrivDBEngine? Mam wiele modułów, które wymagają pomieszania.

Odpowiedz

18

Możesz również wypróbować ten kod. Będzie ona zachować typów plików elementy (.bas, .cls, .frm) Pamiętaj, aby zapoznać się/Sprawdź Microsoft Visual Basic for Applications Extensibility Biblioteka w VBE> Narzędzia> Referencje

Sub ExportAllCode() 

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 
9

Można użyć obiektu Access.Application.

Ponadto, aby uniknąć wielokrotnych okien dialogowych z potwierdzeniami podczas otwierania baz danych, wystarczy zmienić poziom zabezpieczeń w menu Narzędzia/Makra/Zabezpieczenia.

Aby otworzyć wiele baz danych z użytkownikiem/hasłem, można dołączyć do grupy roboczej (Narzędzia/Bezpieczeństwo/Administrator grupy roboczej) i zalogować się za pomocą pożądanego użytkownika/hasła (z bazy danych za pomocą funkcji SaveToFile), a następnie uruchomić kod. Pamiętaj, aby później dołączyć do domyślnej grupy roboczej (możesz spróbować dołączyć do nieistniejącej grupy roboczej, a dostęp przywróci domyślną).

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 

Dodałem kod do modułów raportów. Kiedy dostanę trochę czasu, spróbuję zmienić kod.

Uważam, że to wielki wkład. Dziękuję za udostępnienie.

Pozdrawiam

+0

To świetny kod. Czy masz kod do importowania go z plików do Access? –

+0

Znalazłem moją odpowiedź tutaj: https://stackoverflow.com/questions/31596339/import-a-module-into-access-programmatically-from-a-ls-lub-sililar-file i działa świetnie. –

2

Piękna odpowiedź Clon.

Wystarczy niewielka zmienność jeśli próbujesz otworzyć MDB, który ma formę startowego i/lub AutoExec makro i powyżej nie zawsze wydaje się działać niezawodnie.

Patrząc na tę odpowiedź na innej stronie internetowej: By pass startup form/macros i przewijanie prawie do końca dyskusji jest pewien kod, który tymczasowo pozbywa się ustawień formularza startowego i wyodrębnia makro AutoExec do bazy danych przed napisaniem nad nim za pomocą makra TempAutoExec (co nie działa), działa (między wierszami "Czytaj paski poleceń i app.CloseCurrentDatabase), a następnie naprawi wszystko z powrotem.

5

Podobnie jak w przypadku MS Excel, można również użyć pętli nad Application.VBE.VBProjects(1).VBComponents i użyć metody Export wyeksportować Moduły/classes/formy:

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 

zajmuje tylko ułamek sekundy, aby wykonać.

Pozdrowienia

+0

W rezultacie otrzymałem komunikat o błędzie kompilacji z informacją, że nie udało mi się znaleźć c –

0

innym sposobem jest utrzymanie najczęściej używanego kodu w jednym zewnętrznym pliku master.mdb i dołączenie do dowolnej liczby plików * .mdbs przez moduły-> Narzędzia-> Odnośniki-> Przeglądaj -> ... \ master.mdb

tylko problem w starym 97 Dostępu Możesz debugować, edytować i zapisywać bezpośrednio w destination.mdb, , ale we wszystkich nowszych, od MA 2000, opcja "Zapisz" zniknęła i wszelkie ostrzeżenia o zamknięciu niezapisanego kodu