Office: (Office 2010) Fehler in Fehlerbehandlung

Helfe beim Thema Fehler in Fehlerbehandlung in Microsoft Access Hilfe um das Problem gemeinsam zu lösen; Hallo, ich hab es nochmals angepasst. Der Excel-Part wurde in ein separates Modul geschrieben und als Funktion abgehandelt. Code: Public Function... Dieses Thema im Forum "Microsoft Access Hilfe" wurde erstellt von Forza SGD, 27. Juli 2015.

Seite 2 von 3

FORZA SGD

Forza SGD

Fehler in Fehlerbehandlung

Hallo,

ich hab es nochmals angepasst. Der Excel-Part wurde in ein separates Modul geschrieben und als Funktion abgehandelt.

Code:

Public Function Excel_Instanz(strSource As String, strTarget As String) As Boolean

Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlWks As Excel.Worksheet
Dim xlWkbAdd As Excel.Workbook
Dim xlWksAdd As Excel.Worksheet
Dim Bereich As Range
Dim i As Long

On Error GoTo Err_Handler

Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Open(FileName:=strSource)
Set xlWks = xlWkb.Worksheets(1)

i = (xlWks.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row)

With xlWks
Set Bereich = .Range(.Cells(1, 1), .Cells(i, 7))
End With

Bereich.Copy

Set xlWkbAdd = xlApp.Workbooks.Add
Set xlWksAdd = xlWkbAdd.Worksheets(1)

xlWkbAdd.Worksheets(1).Paste
xlApp.CutCopyMode = False
xlWksAdd.SaveAs strTarget, FileFormat:=xlCSV, Local:=True

Excel_Instanz = (Err.Number = 0)

Exit_Function:

xlWkbAdd.Close SaveChanges:=False
xlWkb.Close SaveChanges:=False

Set Bereich = Nothing
Set xlWks = Nothing
Set xlWksAdd = Nothing
Set xlWkb = Nothing
Set xlWkbAdd = Nothing

xlApp.Quit

Set xlApp = Nothing

'Debug.Print xlApp Is Nothing, xlWkb Is Nothing, xlWkbAdd Is Nothing, Bereich Is Nothing, xlWks Is Nothing, xlWksAdd Is Nothing

Exit Function

Err_Handler:

Excel_Instanz = (Err.Number = 0)

Call MsgBox("Fehlernummer: " & Err.Number _
& vbCrLf & "Beschreibung: " & Err.Description, vbInformation, "Meldung")

Select Case Err.Number

Case "2465"
Exit Function
Case "91"
Exit Function
Case "-2147023179"
Exit Function
Case "-2147417848"
Exit Function
Case Else
Resume Exit_Function

End Select

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Der Aufruf in der Hauptroutine geschieht wie folgt. Die Funktion liefert bei erfolgreichem Abschluss der Arbeiten in der Excel-Instanz der Wert True zurück, was die Fortsetzung der Routine bedeutet. Bei False wird die Routine abgebrochen.

Code:

strPos = InStrRev(Forms!frm_select!txt_dlg.Value, "\")
strLen = Len(Forms!frm_select!txt_dlg.Value)
strFile = Mid(Forms!frm_select!txt_dlg.Value, (strPos + 1), (strLen - strPos))
strEx = GetFileExt(strFile)

If strEx = ".xls" Or strEx = ".xlsx" Then
If Excel_Instanz(path(1), path(3)) = False Then
GoTo Exit_Sub
End If
Else
Call MsgBox(" Die zu importierende Datei hat nicht das erwartete Format!", vbCritical, "Achtung!")
GoTo Exit_Sub
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich hoffe damit unabhängig vom Zeitpunkt des auftretenden Fehlers alles (zumindest das meiste) sauber zu beenden.

An dieser Stelle nochmals besten Dank an Josef und seine hilfreichen Anmerkungen und Verbesserungsvorschläge.

Gibt's hierzu noch Ergänzungen bzw. Verbesserungsvorschläge?

Forza SGD, 4. August 2015

#16
JOSEF P.

Josef P.

Hallo!

Ich bin ein Freund von lesbarem Code. *wink.gif*

If Excel_Instanz(path(1), path(3)) = False Then
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Stell dir vor, du kennst den Inhalt der Prozedur "Excel_Instanz" nicht.
Was passiert in dieser Zeile?

Wird da eine Excel-Instanz erzeugt?

Code-"Schönheitsfehler":

Code:
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Select Case Err.Number
Case "2465"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Err.Nummer ist eine Zahl =>
Code:

Select Case Err.Number
Case 2465
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Bereich.Copy
[...]
xlWkbAdd.Worksheets(1).Paste
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Muss unbedingt über die Zwischenablage kopiert werden?
Ein direktes Zuweisen ist nicht möglich?

Irgendwie so:
Code:

Set Bereich = ... 'Range-Objekt
Set ZielRange = ...
ZielRange.Value = Bereich.Value
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mfg
Josef

Josef P., 4. August 2015

#17
JOSEF P.

Josef P.

Nachtrag:

Ich führte ein Refactoring von deinem Code aus Beitrag #16 durch.
Der Code ist ungetestet, ich übernahm deinen Code, strukturierte ihn etwas anders und fügte die Änderung bezüglich Werte kopieren ein.
Code:

Public Function ExportExcelFileToCsv(strSource As String, strTarget As String) As Boolean

Dim xlApp As Excel.Application
Dim SourceWkb As Excel.Workbook
Dim SourceRange As Excel.Range

On Error GoTo Err_Handler

Set xlApp = New Excel.Application
Set SourceWkb = xlApp.Workbooks.Open(FileName:=strSource)

Set SourceRange = FindSourceRangeInWorkBook(SourceWkb)
If not (SourceRange Is Nothing) Then ' Range gefunden => Export durchführen
ExportExcelFileToCsv = ExportRangeToCsv(xlApp, SourceRange, strTarget)
else
' eventuell Meldung anzeigen?
ExportExcelFileToCsv = False
End If

Exit_Function:

On Error Resume Next ' Methode "brutalo" ;-)

Set SourceRange = Nothing

SourceWkb.Close SaveChanges:=False
Set SourceWkb = Nothing

xlApp.Quit
Set xlApp = Nothing

Exit Function

Err_Handler:

ExportExcelFileToCsv = False

Call MsgBox("Fehlernummer: " & Err.Number & vbNewLine & _
"Beschreibung: " & Err.Description, vbInformation, "Meldung")

Select Case Err.Number
'Bitte prüfen, welche Nummern überhaupt noch benötigt werden!
'Bzw. ob überhaupt auf die Nummern reagiert werden soll. Viel "Abwechslung" sehe ich im Case-Teil nicht. ;-)
Case 2465
Exit Function
Case 91
Exit Function
Case -2147023179
Exit Function
Case -2147417848
Exit Function
Case Else
Resume Exit_Function

End Select

End Function

Private Function FindSourceRangeInWorkBook(ByVal xlWkb As Excel.Workbook) As Excel.Range
' Was ist wenn nichts gefunden wird?
' => eventuell Abbrechen / Nothing zurückgeben

' Können in dieser Prozedur Fehler auftreten, die man beheben kann bzw. abfangen muss?
' => Fehlerbehandlung einfügen

Const FirstRowIndex As Long = 1
Const FirstColumnIndex As Long = 1
Const LastColumnIndex As Long = 7

Dim xlWks As Excel.Worksheet
Dim LastRowRange As Excel.Range
Dim LastRowIndex As Long

Set xlWks = xlWkb.Worksheets(1)

Set LastRowRange = xlWks.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious)
If LastRowRange Is Nothing Then ' Liefert Find(..) Nothing, wenn kein Treffer gefunden wird?
Set FindSourceRangeInWorkBook = Nothing
Exit Function
End If

LastRowIndex = LastRowRange.Row

With xlWks
Set FindSourceRangeInWorkBook = .Range(.Cells(FirstRowIndex, FirstColumnIndex), .Cells(LastRowIndex, LastColumnIndex))
End With

End Function

Private Function ExportRangeToCsv(ByVal xlApp As Excel.Application, ByVal SourceRange As Excel.Range, TargetFilePath As String) As Boolean

Dim TempWkb As Excel.Workbook
Dim TempWks As Excel.Worksheet
Dim TargetRange As Excel.Range

On Error GoTo Err_Handler

Set TempWkb = xlApp.Workbooks.Add
Set TempWks = TempWkb.Worksheets(1)

With TempWks
Set TargetRange = .Range(.Cells(1, 1), .Cells(SourceRange.Rows.Count, SourceRange.Columns.Count))
End With

TargetRange.Value = SourceRange.Value

TempWks.SaveAs TargetFilePath, FileFormat:=xlCSV, Local:=True

ExportRangeToCsv = True

Exit_Function:

On Error Resume Next

Set TargetRange = Nothing
Set TempWks = Nothing
TempWkb.Close SaveChanges:=False
Set TempWkb = Nothing

Exit Function

Err_Handler:
ExportRangeToCsv = False
Resume Exit_Function

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mfg
Josef

Josef P., 4. August 2015

#18
FORZA SGD

Forza SGD

Fehler in Fehlerbehandlung

Hallo Josef,

Danke für die schnelle und umfangreiche Rückmeldung. Ich werde mir deine Optimierung anschauen und aller Wahrscheinlichkeit nach auch umsetzen. Wird heute wohl nichts mehr werden.

Vielen lieben Dank! *top

Forza SGD, 4. August 2015

#19
FORZA SGD

Forza SGD

Hallo Josef,

vielen Dank das von Dir vorgenommene Refactoring. Ich habe Deine Vorschläge soweit mit marginalen Veränderungen umgesetzt.

ExportExcelFileToCsv:

Code:

ublic Function ExportExcelFileToCsv(strSource As String, strTarget As String) As Boolean

Dim xlApp As Excel.Application
Dim SourceWkb As Excel.Workbook
Dim SourceRange As Excel.Range

On Error GoTo Err_Handler

Set xlApp = Excel.Application
Set SourceWkb = xlApp.Workbooks.Open(FileName:=strSource)

Set SourceRange = FindSourceRangeInWorkBook(SourceWkb)

If Not SourceRange Is Nothing Then
ExportExcelFileToCsv = ExportRangeToCsv(xlApp, SourceRange, strTarget)
Else
Call MsgBox("Die zu importierende Excel-Liste ist leer!" _
& vbCrLf & "Der Vorgang wird abgebrochen.", vbCritical, "Achtung!")
ExportExcelFileToCsv = False
End If

Exit_Function:

On Error Resume Next

SourceWkb.Close SaveChanges:=False

Set SourceRange = Nothing
Set SourceWkb = Nothing

xlApp.Quit

Set xlApp = Nothing

Exit Function

Err_Handler:

ExportExcelFileToCsv = False

Call MsgBox("Fehlernummer: " & Err.Number & vbNewLine & _
"Beschreibung: " & Err.Description, vbInformation, "Meldung")

Resume Exit_Function

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

FindSourceRangeInWorkBook:

Code:

Private Function FindSourceRangeInWorkBook(ByVal xlWkb As Excel.Workbook) As Excel.Range

Const FirstRowIndex As Long = 1
Const FirstColumnIndex As Long = 1
Const LastColumnIndex As Long = 7

Dim xlWks As Excel.Worksheet
Dim LastRowRange As Excel.Range
Dim LastRowIndex As Long

On Error GoTo Err_Handler

Set xlWks = xlWkb.Worksheets(1)

Set LastRowRange = xlWks.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious)

If LastRowRange Is Nothing Then
Set FindSourceRangeInWorkBook = Nothing
Exit Function
End If

LastRowIndex = LastRowRange.Row

With xlWks
Set FindSourceRangeInWorkBook = .Range(.Cells(FirstRowIndex, FirstColumnIndex), .Cells(LastRowIndex, LastColumnIndex))
End With

Exit_Function:

On Error Resume Next

Set LastRowRange = Nothing
Set xlWks = Nothing

Err_Handler:

Call MsgBox("Fehlernummer: " & Err.Number & vbNewLine & _
"Beschreibung: " & Err.Description, vbInformation, "Meldung")

Resume Exit_Function

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

ExportRangeToCsv:

Code:

Private Function ExportRangeToCsv(ByVal xlApp As Excel.Application, ByVal SourceRange As Excel.Range, TargetFilePath As String) As Boolean

Dim TempWkb As Excel.Workbook
Dim TempWks As Excel.Worksheet
Dim TargetRange As Excel.Range

On Error GoTo Err_Handler

Set TempWkb = xlApp.Workbooks.Add
Set TempWks = TempWkb.Worksheets(1)

With TempWks
Set TargetRange = .Range(.Cells(1, 1), .Cells(SourceRange.Rows.Count, SourceRange.Columns.Count))
End With

TargetRange.Value = SourceRange.Value

TempWks.SaveAs TargetFilePath, FileFormat:=xlCSV, Local:=True

ExportRangeToCsv = True

Exit_Function:

On Error Resume Next

TempWkb.Close SaveChanges:=False

Set TargetRange = Nothing
Set TempWks = Nothing
Set TempWkb = Nothing

Exit Function

Err_Handler:

ExportRangeToCsv = False

Call MsgBox("Fehlernummer: " & Err.Number & vbNewLine & _
"Beschreibung: " & Err.Description, vbInformation, "Meldung")

Resume Exit_Function

End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Select Case - Anweisung habe ich entfernt. Zwar sah jene recht dürftig aus, doch erfüllte diese folgenden Zweck. Im Falle eines Fehlers im Bereich Exit_Function der Funktion ExportExcelFileToCsv: sollte ein Abbruch herbeigeführt werden, da sich ansonsten die Anwendung in einem Zirkelbezug verirren würde. In der von Dir vorgeschlagenen Variante werden Fehler in diesem Bereich ignoriert, was generell nicht schlimm ist, da die Objektreferenzen der Excel-Instanz sowie die Instanz selbst beim beenden der Hauptroutine zerstört werden und der folgende Code abgearbeitet werden kann. Allerdings könnte ein nicht bearbeiten der Code-Zeile SourceWkb.Close SaveChanges:=False zu Irritationen beim Nutzer führen. Da beim manuellen öffnen der Vorlage-Liste die Speicherabfrage erfolgen würde. Das es zu Fehlern an dieser Stelle kommt ist sicherlich recht unwahrscheinlich. Ich bin mir allerdings nicht sicher ob ich dies in kauf nehmen oder ignorieren sollte.

In der Funktion FindSourceRangeInWorkBook sind per se keine Fehler zu erwarten und der Fall eines leeren Worksheets wurde ja bereits von Dir behandelt.

Wie gesagt alles in allem entspricht dies Deinem Vorschlag. Lediglich die fehlerausgaben in den einzelnen Funktionen habe ich ergänzt, sowie das Schließen aller Objektreferenzen der Excel-Instanz. In der Hauptroutine wird generell noch im falle eines Abbruchs eine Information abgesetzt.

Code:

strPos = InStrRev(Forms!frm_select!txt_dlg.Value, "\")
strLen = Len(Forms!frm_select!txt_dlg.Value)
strFile = Mid(Forms!frm_select!txt_dlg.Value, (strPos + 1), (strLen - strPos))
strEx = GetFileExt(strFile)

If strEx = ".xls" Or strEx = ".xlsx" Then
If ExportExcelFileToCsv(path(1), path(3)) = False Then
Call MsgBox("Der Vorgang wurde auf Grund eines Fehlers im Modul ExcelFileToCsv abgebrochen!", vbCritical, "Achtung!")
GoTo Exit_Sub
End If
Else
Call MsgBox("Die zu importierende Datei entspricht nicht dem erwarteten Format!", vbCritical, "Achtung!")
GoTo Exit_Sub
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Nochmals besten Dank für deine umfangreiche Hilfe. Würdest Du es jetzt so stehen lassen?

Gruß

Andreas

Forza SGD, 5. August 2015

#20
JOSEF P.

Josef P.

Hallo!

Bezüglich Fehlermeldung in Prozeduren (z. B. ExportRangeToCsv), die nicht direkt vom User aufgerufen werden:

Im Prinzip gibst du über den Rückgabewert der aufrufenden Prozedur bekannt, ob die Prozedur ordnungsgemäß durchgeführt wurde.
(Das habe ich im letzten Refactoring so gelassen.)

Ich vermeide in solchen Prozeduren eine Msgbox mit einer Fehlermeldung anzuzeigen, da das meiner Meinung nach die Aufgabe der aufrufenden Prozedur ist.
Ich würde den Fehler abfangen und einen eigenen Fehler mit einer verständlichen Fehlermeldung auslösen.
Dieser Fehler wird dann in der aufrufenden Prozedur (oder noch weiter oben, falls die aufrufende Prozedur keine Fehlerbehandlung hat) abgefangen und weiterverarbeitet. In der obersten Aufrufhierarchie kommt dann die Msgbox zum Einsatz.

Mögliche Änderungen:
FindSourceRangeInWorkBook
Fehlerbehandlung entfernen (Fehler-Info für unerwartete Fehler ist auch weiter oben in der Aufrufhierarchie bekannt.)
Das Nothing-Setzen der Variablen in dieser Prozedur ist kein muss, die sind sowie weg, wenn die Prozedur (auch im Fehlerfall) verlassen wird.

ExportRangeToCsv
Hier wird eine Fehlerbehandlung benötigt, um das Schließen vom TempWkb sicherzustellen.

ExportExcelFileToCsv
"Fehler"-Msgbox auf Err.Raise umstellen.

Aufrufende Prozedur
Goto-Anweisung entfernen und ebenso auf Err.Raise inkl. Fehlerbehandlung umstellen.

Ob diese Änderung gewünscht ist, hängt vom Programmierstil ab. *wink.gif*
Vorteil dieses Konzeptes: man kann als Programmierer die FUnktionen auf verwenden, ohne eine Meldung zu bekommen, wenn man die Fehler aus diesen Prozeduren wie gewünscht behandelt.

=> Dein Code abgeändert mit Err.Raise:
Code:

Private Sub ObersteAufrufEbene()

'...

On Error GoTo Err_Handler

' ...

strPos = InStrRev(Forms!frm_select!txt_dlg.Value, "\")
strLen = Len(Forms!frm_select!txt_dlg.Value)
strFile = Mid(Forms!frm_select!txt_dlg.Value, (strPos + 1), (strLen - strPos))
strEx = GetFileExt(strFile)

If strEx = ".xls" Or strEx = ".xlsx" Then
ExportExcelFileToCsv Path(1), Path(3)
Else
Err.Raise vbObjectError, "....", "Die zu importierende Datei entspricht nicht dem erwarteten Format!"
End If

' ... weiterer Code

Exit Sub

Err_Handler:

MsgBox "Der Vorgang wurde auf Grund eines Fehlers im Modul ExcelFileToCsv abgebrochen!" & _
vbNewLine & "Fehler " & Err.Number & " in " & Err.Source & _
vbNewLine & Err.Description, vbCritical, "Achtung!"

End Sub

Public Function ExportExcelFileToCsv(strSource As String, strTarget As String) As Boolean

Dim xlApp As Excel.Application
Dim SourceWkb As Excel.Workbook
Dim SourceRange As Excel.Range

On Error GoTo Err_Handler

Set xlApp = Excel.Application
Set SourceWkb = xlApp.Workbooks.Open(FileName:=strSource)

Set SourceRange = FindSourceRangeInWorkBook(SourceWkb)

If Not SourceRange Is Nothing Then
ExportExcelFileToCsv = ExportRangeToCsv(xlApp, SourceRange, strTarget)
Else
Err.Raise vbObjectError, "ExportExcelFileToCsv", "Die zu importierende Excel-Liste ist leer!" _
& vbCrLf & "Der Vorgang wird abgebrochen."
End If

CloseWorkbookAndDispose xlApp, SourceWkb, Nothing, SourceRange

Exit Function

Err_Handler:
ExportExcelFileToCsv = False
RaiseErrorAndCleanUp Err.Number, IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "ExportExcelFileToCsv"), Err.Description, xlApp, SourceWkb, Nothing, SourceRange

End Function

Private Function FindSourceRangeInWorkBook(ByVal xlWkb As Excel.Workbook) As Excel.Range

Const FirstRowIndex As Long = 1
Const FirstColumnIndex As Long = 1
Const LastColumnIndex As Long = 7

Dim xlWks As Excel.Worksheet
Dim LastRowRange As Excel.Range
Dim LastRowIndex As Long

Set xlWks = xlWkb.Worksheets(1)

Set LastRowRange = xlWks.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious)

If LastRowRange Is Nothing Then
Set FindSourceRangeInWorkBook = Nothing
Exit Function
End If

LastRowIndex = LastRowRange.Row

With xlWks
Set FindSourceRangeInWorkBook = .Range(.Cells(FirstRowIndex, FirstColumnIndex), .Cells(LastRowIndex, LastColumnIndex))
End With

Set LastRowRange = Nothing
Set xlWks = Nothing

End Function

Private Function ExportRangeToCsv(ByVal xlApp As Excel.Application, ByVal SourceRange As Excel.Range, TargetFilePath As String) As Boolean

Dim TempWkb As Excel.Workbook
Dim TempWks As Excel.Worksheet
Dim TargetRange As Excel.Range

On Error GoTo Err_Handler

Set TempWkb = xlApp.Workbooks.Add
Set TempWks = TempWkb.Worksheets(1)

With TempWks
Set TargetRange = .Range(.Cells(1, 1), .Cells(SourceRange.Rows.Count, SourceRange.Columns.Count))
End With

TargetRange.Value = SourceRange.Value

TempWks.SaveAs TargetFilePath, FileFormat:=xlCSV, Local:=True

ExportRangeToCsv = True
CloseWorkbookAndDispose Nothing, TempWkb, TempWks, TargetRange

Exit Function

Err_Handler:

ExportRangeToCsv = False
RaiseErrorAndCleanUp Err.Number, IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "ExportRangeToCsv"), Err.Description, Nothing, TempWkb, TempWks, TargetRange

End Function

Private Sub RaiseErrorAndCleanUp(ByVal ErrNumber As Long, ByVal ErrSource As String, ByVal ErrDesc As String, ByRef ExcelAppToQuit As Excel.Application, ByRef WorkbookToClose As Excel.Workbook, ByRef WorksheetToSetNothing As Excel.Worksheet, ByRef RangeToSetNothing As Excel.Range)
CloseWorkbookAndDispose ExcelAppToQuit, WorkbookToClose, WorksheetToSetNothing, RangeToSetNothing
Err.Raise ErrNumber, ErrSource, ErrDesc
End Sub

Private Sub CloseWorkbookAndDispose(ByRef ExcelAppToQuit As Excel.Application, ByRef WorkbookToClose As Excel.Workbook, ByRef WorksheetToSetNothing As Excel.Worksheet, ByRef RangeToSetNothing As Excel.Range)

On Error Resume Next

Set RangeToSetNothing = Nothing
Set WorksheetToSetNothing = Nothing

If Not (WorkbookToClose Is Nothing) Then
WorkbookToClose.Close SaveChanges:=False
Set WorkbookToClose = Nothing
End If

If Not (ExcelAppToQuit Is Nothing) Then
ExcelAppToQuit.Quit
Set ExcelAppToQuit = Nothing
End If

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mfg
Josef

Josef P., 5. August 2015

#21
FORZA SGD

Forza SGD

Hallo Josef,

ich sehe mich genötigt mich zu rechtfertigen *Smilie Die Fehlermeldungen in den Unterfunktionen hatte ich eingefügt um gezielt den Ort der Fehlerentstehung zurückzumelden (auch wenn dies derzeit noch nicht im den etwaigen MSG-Boxen so hinterlegt war), verbunden mit der Hoffnung Fehler, welche Anwender melden besser eingrenzen zu können und nachzuvollziehen.

dafür gibt es sicherlich elegantere Lösungen. Ich hab mich schon einmal in die Raise-Methode eingelesen *Smilie Morgen schaue ich mir Deine Verbesserungsvorschläge an.

Vielen lieben Dank. Ich wünsche einen schönen Abend.

gruß

Andreas

Forza SGD, 5. August 2015

#22
JOSEF P.

Josef P.

Fehler in Fehlerbehandlung

Hallo!

Fehler, welche Anwender melden besser eingrenzen zu können und nachzuvollziehen
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das kannst du auch mit Err.Raise und dem Source-Parameter umsetzen. *wink.gif*

Die Err.Raise-Variante hat noch einen Vorteil: man kann die Prozeduren in einem Unit-Test laufen lassen, da in einem Unit-Test die Fehler ohne Probleme auswertbar sind. Eine angezeigte MsgBox im Client ist allerdings aus Unit-Test-Sicht schwer auswertbar.

Eines vergaß ich im letzen Code:
Code:

IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "ExportExcelFileToCsv")
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

VBE.ActiveVBProject.Name würde ich im "Echt-Code" einer Anwendung durch eine globale Konstante ersetzen, damit sichergestellt ist, dass es keine Probleme mit der Erkennung der Auswertung von VBE.ActiveVBProject geben kann.

mfg
Josef

Josef P., 5. August 2015

#23
FORZA SGD

Forza SGD

Hallo Josef,

anbei eine überarbeitete Fassung. Ich habe einige Kleinigkeiten geändert. Die Funktion ExportExcelFileToCsv habe ich wieder in eine Prozedur gewandelt. Durch die Verwendung von Err.Raise ist die Rückgabe eines booleschen Wertes zur Prüfung eines erfolgreichen Durchlaufs nicht mehr nötig. Sollte ich mich irren, korrigiere mich bitte.

FindSourceRangeInWorkBook
Fehlerbehandlung entfernen (Fehler-Info für unerwartete Fehler ist auch weiter oben in der Aufrufhierarchie bekannt.)
Das Nothing-Setzen der Variablen in dieser Prozedur ist kein muss, die sind sowie weg, wenn die Prozedur (auch im Fehlerfall) verlassen wird.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich hoffe ich wirke jetzt nicht beratungsresistent. Ich habe dennoch eine Fehlerbehandlung eingefügt. Auch wenn das Nothing-Setzen der Variablen überflüssig ist, so schadet es doch auch nicht *Smilie

Aufruf in der Hauptprozedur:

Code:

...

strPos = InStrRev(Forms!frm_select!txt_dlg.Value, "\")
strLen = Len(Forms!frm_select!txt_dlg.Value)
strFile = Mid(Forms!frm_select!txt_dlg.Value, (strPos + 1), (strLen - strPos))
strEx = GetFileExt(strFile)

If strEx = ".xls" Or strEx = ".xlsx" Then
Call ExportExcelFileToCsv(path(1), path(3))
Else
Err.Raise vbObjectError + 7221503, "Import-Modul", "Die zu importierende Datei entspricht nicht dem erwarteten Format!"
End If

...

Err_Handler:

Call MsgBox("Fehlernummer: " & Err.Number _
& vbCrLf & "Fehlerquelle: " & Err.Source _
& vbCrLf & "Beschreibung: " & Err.Description _
& vbCrLf & vbCrLf & "Der Vorgang wird abgebrochen!", vbInformation, "Meldung")

Resume Exit_Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Modul - ExportExcelToCsv:

Code:

Option Compare Database
Option Explicit

Public Sub ExportExcelFileToCsv(strSource As String, strTarget As String)

Dim xlApp As Excel.Application
Dim SourceWkb As Excel.Workbook
Dim SourceRange As Excel.Range

On Error GoTo Err_Handler

Set xlApp = Excel.Application
Set SourceWkb = xlApp.Workbooks.Open(FileName:=strSource)

Set SourceRange = FindSourceRangeInWorkBook(SourceWkb)

If Not SourceRange Is Nothing Then
Call ExportRangeToCsv(xlApp, SourceRange, strTarget)
Else
Err.Raise vbObjectError + 7221502, "ExportExcelFileToCsv", "Die zu importierende Excel-Liste ist leer!"
End If

CloseWorkbookAndDispose xlApp, SourceWkb, Nothing, SourceRange

Exit Sub

Err_Handler:

Debug.Print Err.Number, Err.Source

RaiseErrorAndCleanUp Err.Number, IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "ExportExcelFileToCsv"), Err.Description, xlApp, SourceWkb, Nothing, SourceRange

End Sub

Private Function FindSourceRangeInWorkBook(ByVal xlWkb As Excel.Workbook) As Excel.Range

Const FirstRowIndex As Long = 1
Const FirstColumnIndex As Long = 1
Const LastColumnIndex As Long = 7

Dim xlWks As Excel.Worksheet
Dim LastRowRange As Excel.Range
Dim LastRowIndex As Long

On Error GoTo Err_Handler

Set xlWks = xlWkb.Worksheets(1)

Set LastRowRange = xlWks.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious)

If LastRowRange Is Nothing Then
Set FindSourceRangeInWorkBook = Nothing
Exit Function
End If

LastRowIndex = LastRowRange.Row

With xlWks
Set FindSourceRangeInWorkBook = .Range(.Cells(FirstRowIndex, FirstColumnIndex), .Cells(LastRowIndex, LastColumnIndex))
End With

CloseWorkbookAndDispose Nothing, Nothing, xlWks, LastRowRange
Exit Function

Err_Handler:

RaiseErrorAndCleanUp Err.Number, IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "FindSourceRangeInWorkBook"), Err.Description, Nothing, Nothing, xlWks, LastRowRange

End Function

Private Sub ExportRangeToCsv(ByVal xlApp As Excel.Application, ByVal SourceRange As Excel.Range, TargetFilePath As String)

Dim TempWkb As Excel.Workbook
Dim TempWks As Excel.Worksheet
Dim TargetRange As Excel.Range

On Error GoTo Err_Handler

Set TempWkb = xlApp.Workbooks.Add
Set TempWks = TempWkb.Worksheets(1)

With TempWks
Set TargetRange = .Range(.Cells(1, 1), .Cells(SourceRange.Rows.Count, SourceRange.Columns.Count))
End With

TargetRange.Value = SourceRange.Value

TempWks.SaveAs TargetFilePath, FileFormat:=xlCSV, Local:=True

CloseWorkbookAndDispose Nothing, TempWkb, TempWks, TargetRange
Exit Sub

Err_Handler:

RaiseErrorAndCleanUp Err.Number, IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "ExportRangeToCsv"), Err.Description, Nothing, TempWkb, TempWks, TargetRange

End Sub

Private Sub RaiseErrorAndCleanUp(ByVal ErrNumber As Long, _
ByVal ErrSource As String, _
ByVal ErrDesc As String, _
ByRef ExcelAppToQuit As Excel.Application, _
ByRef WorkbookToClose As Excel.Workbook, _
ByRef WorksheetToSetNothing As Excel.Worksheet, _
ByRef RangeToSetNothing As Excel.Range)

CloseWorkbookAndDispose ExcelAppToQuit, WorkbookToClose, WorksheetToSetNothing, RangeToSetNothing

Err.Raise ErrNumber, ErrSource, ErrDesc

End Sub

Private Sub CloseWorkbookAndDispose(ByRef ExcelAppToQuit As Excel.Application, _
ByRef WorkbookToClose As Excel.Workbook, _
ByRef WorksheetToSetNothing As Excel.Worksheet, _
ByRef RangeToSetNothing As Excel.Range)

On Error Resume Next

If Not (RangeToSetNothing Is Nothing) Then
Set RangeToSetNothing = Nothing
End If

If Not (WorksheetToSetNothing Is Nothing) Then
Set WorksheetToSetNothing = Nothing
End If

If Not (WorkbookToClose Is Nothing) Then
WorkbookToClose.Close SaveChanges:=False
Set WorkbookToClose = Nothing
End If

If Not (ExcelAppToQuit Is Nothing) Then
ExcelAppToQuit.Quit
Set ExcelAppToQuit = Nothing
End If

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich hoffe auf einem guten Weg zu sein. Vielen lieben Dank für die Hilfe.

Forza SGD, 7. August 2015

#24
JOSEF P.

Josef P.

Hallo!

Stimmt, die Rückgabe von True/False ist nicht mehr erforderlich, da im Fehlerfall sowie der Fehler in der aufrufenden Prozedur landet.

FindSourceRangeInWorkBook:

Ich habe dennoch eine Fehlerbehandlung eingefügt. Auch wenn das Nothing-Setzen der Variablen überflüssig ist, so schadet es doch auch nicht
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Solange die Fehlerbehandlung den Fehler nach oben weitergibt, schadet sie in Unterprozeduren nicht. ;-)

mfg
Josef

Josef P., 7. August 2015

#25
FORZA SGD

Forza SGD

Solange die Fehlerbehandlung den Fehler nach oben weitergibt, schadet sie in Unterprozeduren nicht. ;-)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Meiner Meinung nach sollte dies geschehen. Produziert die Funktion FindSourceRangeInWorkBook einen Fehler wird dieser dokumentiert und im Folgenden wird zum Error-Handler der Prozedur ExportExcelFileToCsv gesprungen.

Forza SGD, 7. August 2015

#26
FORZA SGD

Forza SGD

Ein Frage bleibt noch ...

Code:

Err.Source VBE.ActiveVBProject.Name
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wann könnte denn in meiner Prozedur ein solcher Fall erfüllt sein? Würde es nicht ausreichen an Stelle der Err.Source stetig den Prozedur- bzw. Funktions-Namen anzugeben?

VBE.ActiveVBProject.Name würde ich im "Echt-Code" einer Anwendung durch eine globale Konstante ersetzen, damit sichergestellt ist, dass es keine Probleme mit der Erkennung der Auswertung von VBE.ActiveVBProject geben kann.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Was könnten das für Probleme sein? So wie ich dies verstanden habe wird, auch hier im Forum, von der Verwendung Globaler Variablen abgeraten, insofern dies zu vermeiden ist.

OT: Die Variante mit den Prozeduren RaiseErrorAndCleanUp sowie CloseWorkbookAndDispose finde ich sehr gelungen, da zu jeder Zeit bei auftretenden Fehlern die Prozedur sauber verlassen wird. Dies wollte ich nochmals erwähnen, da diese Problematik ursprünglich mal Auslöser dieses Diskussionsbeitrags war.

*top

Forza SGD, 7. August 2015

#27
JOSEF P.

Josef P.

Fehler in Fehlerbehandlung

Hallo!

von der Verwendung Globaler Variablen abgeraten,
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Eine globale Konstante ist keine globale Variable. ;-)

Code:

err.Raise ..., IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "ExportExcelFileToCsv"), ...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Wann könnte denn in meiner Prozedur ein solcher Fall erfüllt sein?
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Standard-Source, wenn der Fehler durch eine VBA-Funktion ausgelöst ist, ist der VB-Projekt-Name. Der ist nicht sehr hilfreich bei der Suche nach dem Fehler => Prozedurnamen einfügen.
Sobald aber einmal ein passender Name vergeben wurde, sollte der nicht noch einmal überschrieben werden.

Beispiel:
Code:

sub ObersteAufrufebene()

on error goto HandleErr

Call Proc1

exit sub

HandleErr:
msgbox "Fehler " & Err.Number & " in " & Err.Source & vbnewline & Err.Description

end Sub

private sub Proc1

on error goto HandleErr

Call Proc2

... weiterer Code, bei dem auch der Fehler behandelt gehört ...

exit sub

HandleErr:
... Fehlerbehandlung ...

' Fehler wieder auslösen:
Err.Raise Err.Number, IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "Proc1"), Err.Description
' Anm.: Würde man hier nicht iif verwenden, sondern nur Proc1 schreiben, würde man nicht erkennen, dass der Fehler in Proc2 entstand.
end Sub

private sub Proc2

dim x as long

on error goto HandleErr

'... Code, bei dem auch der Fehler behandelt gehört ...

'fehler zum Testen auslösen:
x = 1 / 0

exit sub

HandleErr:
'... Fehlerbehandlung ...

' Fehler wieder auslösen:
Err.Raise Err.Number, IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "Proc2"), Err.Description

end Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gute Alternative zu
Code:

err.Raise Err.Number, IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "AktuellerProzedurname"), Err.Description
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Den Fehlerentstehungs-"Pfad" anzeigen:
Code:

err.Raise Err.Number, "AktuellerProzedurname" & IIf(Err.Source VBE.ActiveVBProject.Name, "->" & Err.Source, vbNullstring), Err.Description
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mfg
Josef

Josef P., 7. August 2015

#28
FORZA SGD

Forza SGD

Hallo Josef,

Eine globale Konstante ist keine globale Variable. ;-)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ein klassischer Fall von DUMM - Konstanten sind keine Variablen, verstehe *Smilie

Sobald aber einmal ein passender Name vergeben wurde, sollte der nicht noch einmal überschrieben werden.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Des Weiteren vielen Dank für dein ausführlichen Beispiel. Ich versuche mich einmal herauszureden. Es sind gefühlte 50 Grad in meinem Büro, was ich mal als Anlass nehme meine geistige Trägheit zu rechtfertigen ... Aber! Ich habe es nun verstanden ...

Danke für Deine Geduld.

Forza SGD, 7. August 2015

#29
FORZA SGD

Forza SGD

Hallo Josef,

ich hoffe Du hattest ein entspanntes Wochenende. es gab doch noch ein Problem, von welchem ich berichten möchte. Der Übertrag der SourceRange auf die TargetRange führte dazu, dass das beim Textfeld Postleitzahl die führende Null gestrichen wurde, sprich Excel den zu übertragenden Wert als Zahl interpretiert hat. Da die Variante mittels des Zwischenspeichers nicht mehr bemüht werden sollte, habe ich die TargetRange in der Subroutine ExportRangeToCsv vorformatiert. Dies führte zum gewünschten Ergebnis. Kann ich dies so stehen lassen, oder sind auch hier Probleme zu erwarten?

Code:

Private Sub ExportRangeToCsv(ByVal xlApp As Excel.Application, ByVal SourceRange As Excel.Range, TargetFilePath As String)

Dim TempWkb As Excel.Workbook
Dim TempWks As Excel.Worksheet
Dim TargetRange As Excel.Range

On Error GoTo Err_Handler

Set TempWkb = xlApp.Workbooks.Add
Set TempWks = TempWkb.Worksheets(1)

With TempWks
Set TargetRange = .Range(.Cells(1, 1), .Cells(SourceRange.Rows.Count, SourceRange.Columns.Count))
End With

With TargetRange
.Range(.Cells(1, 1), .Cells(SourceRange.Rows.Count, 1)).NumberFormat = "0"
.Range(.Cells(1, 2), .Cells(SourceRange.Rows.Count, 2)).NumberFormat = "@"
.Range(.Cells(1, 3), .Cells(SourceRange.Rows.Count, 3)).NumberFormat = "0"
.Range(.Cells(1, 4), .Cells(SourceRange.Rows.Count, 4)).NumberFormat = "@"
.Range(.Cells(1, 5), .Cells(SourceRange.Rows.Count, 5)).NumberFormat = "@"
.Range(.Cells(1, 6), .Cells(SourceRange.Rows.Count, 6)).NumberFormat = "0"
.Range(.Cells(1, 7), .Cells(SourceRange.Rows.Count, 7)).NumberFormat = "0"
End With

TargetRange.Value = SourceRange.Value

TempWks.SaveAs TargetFilePath, FileFormat:=xlCSV, Local:=True

CloseWorkbookAndDispose Nothing, TempWkb, TempWks, TargetRange

Exit Sub

Err_Handler:

Debug.Print Err.Source

RaiseErrorAndCleanUp Err.Number, IIf(Err.Source VBE.ActiveVBProject.Name, Err.Source, "ExportRangeToCsv"), Err.Description, Nothing, TempWkb, TempWks, TargetRange

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Forza SGD, 9. August 2015

#30

(Du musst angemeldet oder registriert sein, um eine Antwort erstellen zu können.)

Seite 2 von 3

Thema:

Fehler in Fehlerbehandlung

Die Seite wird geladen...

Fehler in Fehlerbehandlung - Similar Threads - Fehler Fehlerbehandlung
Fehler (0x800CCC78) beim Ausführen der Aufgabe "xx.yyyy@kabelmail.de - Nachrichten werden gesendet"
in Microsoft Outlook Hilfe
Fehler (0x800CCC78) beim Ausführen der Aufgabe "xx.yyyy@kabelmail.de - Nachrichten werden gesendet": Bei mir taucht im Outlook ständig folgender Fehler auf: (0x800CCC78) beim Ausführen der Aufgabe "xx.yyyy@kabelmail.de - Nachrichten werden gesendet": "Die Nachricht kann nicht gesendet werden....
Fehler beim SVERWEIS Vermeidbar?
in Microsoft Excel Hilfe
Fehler beim SVERWEIS Vermeidbar?: Hallo, ich habe eine Tabelle mit SVERWEIS. Der erste Tab ist quasi eine Übersicht nach Jahren und dann die weiteren Tabs die Eingaben in den Jahren (Artikel, Bestand, Einkaufspreis usw). Die...
Installation schlägt fehl - Fehler in OfficeClickToRun.exe
in Sonstiges
Installation schlägt fehl - Fehler in OfficeClickToRun.exe: Hallo, ich habe ein Problem beim Installieren von Office Ich erhalte die folgende Fehlermeldung: ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ OfficeClickToRun.exe - Anwendungsfehler Die Anwendung...
Bei meinem Outlook (new) fehlen wichtige Funktionen!
in Microsoft Outlook Hilfe
Bei meinem Outlook (new) fehlen wichtige Funktionen!: Hallo, wie der Titel bereits andeutet, habe ich Probleme mit Outlook. Zum Beispiel ist es mir nicht möglich, Add-ins zu installieren. Es gibt keinen Button dafür, und auch wenn ich über die...
Ständige Passwortabfrage und Kalendersyncronisations Fehler
in Microsoft Outlook Hilfe
Ständige Passwortabfrage und Kalendersyncronisations Fehler: Guten Tag, ich bin neu in diesem Forum und hoffe nach vergeblicher Suche im Microsoft Forum hier Hilfe zu bekommen. Nach einem Wechsel von Win 10 auf 11 Anfang dieses Jahres habe ich folgende 2...
Formel mit INDEX, MATCH und MAX gibt Fehler #NAME!
in Microsoft Excel Hilfe
Formel mit INDEX, MATCH und MAX gibt Fehler #NAME!: Hallo zusammen, ich habe mit Hilfe von Copliot eine Formel gebaut, die 2 Werte aus einer Tabelle 1 in einer Tabelle 2 prüfen soll und wenn die Konstellation vorkommt, soll das größte Wert dieser...
Wert Fehler
in Microsoft Excel Hilfe
Wert Fehler: Hallo zusammen, sicher gibt es schon diverse Beiträge, leider habe ich keinen gefunden, der mein Problem los. Ich habe mal einen Auszug meiner Tabelle angehängt. Leider kriege ich in einigen...

Anmelden oder registrieren

Suche

Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.

Akzeptieren Weitere Informationen...

Information ausblenden