2013-06-05 12 views
13

Ho trovato un certo codice su un antico bordo di messaggio che ben esporta tutto il codice VBA dalle classi, moduli e forme (vedi sotto):Esportazione di moduli di accesso MS e classi/moduli in modo ricorsivo nei file di testo?

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 

Tuttavia, questo codice non risolve il mio problema dal momento che ho 110 ms-access *.mdb 's che ho bisogno di esportare il VBA da file di testo adatto per grepping.

I percorsi dei 110 file che mi interessano sono già memorizzati in una tabella e il mio codice ha già acquisito queste informazioni in modo ricorsivo (insieme ad altri filtri) ... quindi la parte ricorsiva è terminata.

La maggior parte di questi file viene aperta da un file di sicurezza utente ad accesso singolo, un .mdw e ho provato diversi metodi per aprirli. ADO e ADOX funzionavano alla grande quando stavo cercando tabelle collegate in queste directory ... ma il codice sopra comporta being inside the database you are exporting the data from e voglio essere in grado di farlo da un database separato che apre tutti i mdb s ed esegue l'esportazione su ognuno di loro.

Uno dei miei tentativi in ​​questo è stato l'utilizzo della classe PrivDBEngine per connettersi esternamente ai database, ma non mi consente di accedere all'oggetto Application, che è ciò che richiede il codice di esportazione precedente.

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 

Esiste un modo per accedere all'oggetto application da un PrivDBEngine? Ho un sacco di moduli che hanno bisogno di grepping.

risposta

18

Si può anche provare questo codice. Si manterrà tipi di file le voci (BAS, .cls, .frm) Ricordarsi di fare riferimento a/Controllare il Microsoft Visual Basic per Applications Extensibility Biblioteca in VBE> Strumenti> Riferimenti

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

È possibile utilizzare l'oggetto Access.Application.

Inoltre, per evitare più finestre di conferma durante l'apertura dei database, è sufficiente modificare il livello di sicurezza in Strumenti/Macro/Sicurezza.

E per aprire più database con utente/password è possibile unirsi al gruppo di lavoro (Strumenti/Sicurezza/Amministratore gruppi di lavoro) e accedere con l'utente/password desiderato (dal database con la funzione SaveToFile), quindi eseguire il codice. Ricorda, in seguito, di unirti al gruppo di lavoro predefinito (puoi provare ad unirti a un gruppo di lavoro inesistente e l'accesso tornerà all'impostazione predefinita).

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 

Ho aggiunto il codice per i moduli Report. Quando avrò un po 'di tempo proverò a rifattorizzare il codice.

Trovo questo un grande contributo. Grazie per la condivisione.

Saluti

+0

Questo è un grande codice. Hai il codice per importarlo di nuovo, da file ad Access? –

+0

Ho trovato la mia risposta qui: https://stackoverflow.com/questions/31596339/importing-a-module-into-access-programmatically-from-a-cls-or-similar-file e funziona benissimo. –

2

Bella risposta Clon.

Basta una leggera variazione, se si sta tentando di aprire MDB che ha una forma avvio e/o un macro AutoExec e soprattutto non sembra sempre funzionare in modo affidabile.

Guardando questa risposta su un altro sito: By pass startup form/macros e scorrendo quasi fino alla fine della discussione è un po 'di codice che temporaneamente si sbarazza delle impostazioni del modulo di avvio ed estrae la macro AutoExec al database prima di scrivere su di esso con una macro TempAutoExec (che non fa nulla), funziona (tra le righe 'Leggi le barre di comando e app.CloseCurrentDatabase) e quindi corregge tutto nuovamente.

5

Come per MS Excel, è possibile anche utilizzare un ciclo sopra la Application.VBE.VBProjects(1).VBComponents e utilizzare il metodo Export per esportare i moduli/classi/moduli:

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 

dura solo una frazione di secondo per l'esecuzione.

Acclamazioni

+0

Alla fine ho ricevuto un errore di compilazione che indicava che non riusciva a trovare c –

0

un altro modo è mantenere il codice più usato in un master.mdb esterno e collegarlo a qualsiasi conteggio di * .mdbs tramite Moduli-> Strumenti-> Riferimenti-> Sfoglia -> ... \ master.mdb

l'unico problema nel vecchio 97 Accesso che puoi eseguire il debug, modificare e salvare direttamente in destination.mdb, ma in tutti i più recenti, dal momento che MA 2000, l'opzione 'Salva' è sparita e qualsiasi avvertimento sul codice di chiusura non salvato

Problemi correlati