PDA

View Full Version : [SOLVED] Excel VBA Automation Error (and Crash) when running macro twice



nikki333
03-07-2019, 11:55 AM
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

nikki333
03-08-2019, 06:00 AM
It seems that the problem lies in the "ThisWorkbook.SaveCopyAs" method when the filename already exists.