Hi Folks
I've added code import/export macros to my project, that is one macro for each.
What the export macro does, is that it exports each code component (Workbook/Worksheet, Module, and Form Code) as .txt file in a new folder that gets a time stamp in the folder name.
The import macro looks for the newest time stamp in the export folder and replaces all code in the current file accordingly, including itself (which I admit is a bit risky).
So far so good. This works fine, however, when running either macro for a second time within one session, I get a fatal automation error, followed by an appcrash.
The automation error is not specific and I can't see the line that causes the error, since this kind of procedure does not allow break points in the code.
As far as I understood from googling it has to do with object variables that are released too early in the code, or not realeased...I don't know.
Below you can see the module in question:
'070319@193715 (Code importiert von Bi96 Formen) Option Private Module 'Prozeduren werden nicht unter Entwicklertoos > Makros (Alt + F8) angezeigt Option Compare Text 'Textvergleiche ignorieren Gross-/Kleinschreibung (z.B. A=a=Ä=ä) Option Explicit 'Variablen müssen deklariert werden ("Public.." (global), "Dim.." (lokal)) Option Base 1 'Arrays beginnen i.d.R. mit 1 anstatt standardmässig mit 0 'Alle VBE CodeKomponenten als individuelle Dateien exportieren (Hauptprozedur) Sub subVBKomponentenExportieren(Optional strVorgängerprozedur As String) On Error GoTo Fehler 'Prozedurlog/Excel Optionen setzen strProzedurlog = "subVBKomponentenExportieren" With Application: .ScreenUpdating = False: .EnableEvents = False: End With 'Variablen dimensionieren subOrderpfadErmitteln "CodeExport" Set VBProj = ThisWorkbook.VBProject 'MessageBox Export bestätigen If strVorgängerprozedur = "btnCodeExportieren" Then If blnPersönlicheAnsprache = True Then strMessage = "Willst du fortfahren?" Else strMessage = "Wollen Sie fortfahren?" If MsgBox("Alle in dieser Datei enthaltenen VBA Codekomponenten werden exportiert und als aktuelle CodeVersion für zukünftiges Importieren gehandhabt!" _ & vbNewLine & vbNewLine & strMessage, vbInformation + vbOKCancel, "VBA Code exportieren") = vbCancel Then GoTo Abbruch End If End If 'Für jede Codekomponente eine CodeVersion hinzufügen (in die erste Zeile) For Each VBComp In VBProj.VBComponents Set CodeMod = VBComp.CodeModule With CodeMod If InStr(1, .Lines(1, 1), "@") > 0 Then .ReplaceLine 1, "'" & strZeitStempel & " (Code importiert von " & strAnlage & ")" Else .InsertLines 1, "'" & strZeitStempel & " (Code importiert von " & strAnlage & ")" .InsertLines 2, " " End If End With Next VBComp 'Für jede Codekomponente eine Datei erstellen (.txt für Workbook/Worksheet Elemente und .bas für Standard Module) MkDir (strExportOrdner) For Each VBComp In VBProj.VBComponents With VBComp Set CodeMod = VBComp.CodeModule With CodeMod Set fsoTextDatei = fso.CreateTextFile(strExportOrdner & "\" & .Name & ".txt") strCodeMod = .Lines(1, .CountOfLines) With fsoTextDatei .Write strCodeMod .Close End With End With End With Next VBComp 'Codeversion in Dokumentkommentare schreiben ThisWorkbook.BuiltinDocumentProperties("comments").Value = strZeitStempel 'Projekt kompilieren Status setzten wsHelfer.Range("B19") = 0 'Aktuelle Datei exportieren (Backup) subVBKomponentenImportieren "Nebenprozedur", strExportOrdner Abbruch: 'Prozedurlog/Excel Optionen setzen wsHelfer.Range("C9") = strProzedurlog strProzedurlog = "" With Application: .EnableEvents = True: .ScreenUpdating = True: End With Exit Sub Fehler: 'Fehler in das Blatt "Fehlerlog" schreiben subFehlerBehandlung "mod99.subVBKomponentenExportieren", "Hauptprozedur" End Sub 'Alle VBE CodeKomponenten in aktuelle Datei importieren (Haupt-/Nebenprozedur) Sub subVBKomponentenImportieren(Optional strProzedurtyp As String, Optional strCodeOrdner As String) On Error GoTo Fehler 'Prozedurlog/Excel Optionen setzen If Not strProzedurtyp = "Nebenprozedur" Then strProzedurlog = "subVBKomponentenImportieren" With Application: .ScreenUpdating = False: .EnableEvents = False: End With Else strProzedurlog = strProzedurlog & " | subVBKomponentenImportieren" End If 'Variablen dimensionieren/speichern Dim datDatumAktuellerOrdner As Date Dim datDatumNeusterOrdner As Date Dim fsoImportOrdner As Object Dim strImportOrdner As String Dim objDatei As Object Dim fsoOrdner As Object Dim blnAbbrechen As Boolean subOrderpfadErmitteln "DateiExport" If Dir(strDateiPfad, vbDirectory) = "" Or Dir(strExportOrdner, vbDirectory) = "" Then If Not ThisWorkbook.Name = strAnlage & ".xlsm" Then If blnPersönlicheAnsprache = True Then strMessage = "ändere" Else strMessage = "ändern Sie" MsgBox "Bitte " & strMessage & " zuerst den Dateinamen wie folgt:" & vbNewLine & vbNewLine _ & "Rüstliste " & strAnlage & ".xlsm", vbInformation + vbOKOnly, "Dateiname" Else MsgBox "Der gesuchte Import-/Exportordner wurde nicht gefunden. Die Prozedur wird abgebrochen!", _ vbInformation + vbOKOnly, "Import-/ExportOrdner" End If blnAbbrechen = True GoTo Abbruch End If Set VBProj = ThisWorkbook.VBProject Set fsoImportOrdner = fso.GetFolder(strDateiPfad) Set fsoImportOrdner = fsoImportOrdner.SubFolders 'Aktuelle Datei exportieren (Backup) strZeitStempel = ThisWorkbook.BuiltinDocumentProperties("comments").Value strExportOrdner = strExportOrdner & strAnlage If Dir(strExportOrdner, vbDirectory) = "" Then MkDir (strExportOrdner) End If Application.Calculate ThisWorkbook.SaveCopyAs strExportOrdner & "\Rüstliste " & strAnlage & " " & strZeitStempel & ".xlsm" strMessage = "Eine Kopie dieser Datei wurde wie folgt exportiert: " & vbNewLine & vbNewLine & _ strExportOrdner & "\Rüstliste " & strAnlage & " " & strZeitStempel & ".xlsm" If Not strProzedurtyp = "Hauptprozedur" Then If Not strCodeOrdner = "" Then MsgBox "VBA Codekomponenten wurden wie folgt exportiert:" _ & vbNewLine & vbNewLine & strCodeOrdner & "\" & vbNewLine & vbNewLine & vbNewLine _ & strMessage, vbInformation + vbOKOnly, "Dateiexport" Else MsgBox strMessage, vbInformation + vbOKOnly, "Dateiexport" End If Exit Sub End If 'Neusten ImportPfad ermitteln For Each fsoOrdner In fsoImportOrdner If fsoOrdner.Name Like "*@*" Then datDatumAktuellerOrdner = fsoOrdner.DateCreated If strImportOrdner = "" Then strImportOrdner = fsoOrdner.Path datDatumNeusterOrdner = datDatumAktuellerOrdner ElseIf datDatumAktuellerOrdner > datDatumNeusterOrdner Then datDatumNeusterOrdner = datDatumAktuellerOrdner strImportOrdner = fsoOrdner.Path End If End If Next fsoOrdner If Not strImportOrdner = "" Then Set fsoOrdner = fso.GetFolder(strImportOrdner) strZeitStempel = Mid(strImportOrdner, InStr(1, strImportOrdner, "@") - 6, 13) ThisWorkbook.BuiltinDocumentProperties("comments").Value = strZeitStempel wsHelfer.Range("B19") = 0 Else MsgBox "Es befinden sich keine CodeVersionen in diesem Ordner!", _ vbInformation + vbOKOnly, "Fehlende CodeVersionen" Exit Sub End If 'Neuste CodeKomponenten importieren For Each objDatei In fsoOrdner.Files For Each VBComp In VBProj.VBComponents With VBComp If Left(objDatei.Name, Len(objDatei.Name) - 4) = .Name Then Set fsoTextDatei = fso.OpenTextFile(objDatei.Path, ForReading, False) With fsoTextDatei strCodeMod = .ReadAll .Close End With Set CodeMod = .CodeModule With CodeMod .DeleteLines 1, .CountOfLines .InsertLines 1, strCodeMod End With Exit For End If End With Next VBComp Next objDatei Abbruch: 'Prozedurlog/Excel Optionen setzen wsHelfer.Range("C9") = strProzedurlog strProzedurlog = "" With Application: .EnableEvents = True: .ScreenUpdating = True: End With 'MessageBox If Not blnAbbrechen = True Then MsgBox "Die aktuellsten VBA Codekomponenten wurden importiert:" _ & vbNewLine & vbNewLine & "CodeVersion " & strZeitStempel & vbNewLine & vbNewLine & vbNewLine _ & strMessage, vbInformation + vbOKOnly, "VBA Codeimport" End If Exit Sub Fehler: 'Fehler in das Blatt "Fehlerlog" schreiben ("Hauptprozedur") oder Fehler verursachen ("Nebenprozedur") If Not strProzedurtyp = "Nebenprozedur" Then strProzedurtyp = "Hauptprozedur" subFehlerBehandlung "mod99.subVBKomponentenImportieren", strProzedurtyp End Sub
Reply With Quote