skyacer
Goto Top

VBA Anpassung für Laufwerkmapping mit User und Passwort

Hilfe bei VBA Anpassung für Laufwerkmapping mit User und Passwort

Hallo,

bin grade dabei mir ein Script anzupassen womit ich zu Hause mich mit meinem NAS verbinden kann ohne das jemand mein User bzw Password weiß.

Folgende Lösung funktioniert soweit bis auf die Ausgabe der Errorcodes falls welche auftreten. Ich find einfach nicht herraus was ich noch verändern muss damit diese richtig ausgegeben werden.
Dann würd ich auch gern noch statt das ich den User eingeben muss das ich ein Auswahlfeld habe wo ich den User auswählen kann. Könnte mir da auch jemand helfen?

Grüße Sky

' Bei Fehlern Script weiterlaufen lassen  
On Error Resume Next

'--------------------------------------------------------------------  
' Netzlaufwerke f: bis z: trennen Asc(f)=102 ...Asc(z)=122  
' ACHTUNG: auf Kleinschreibung bei Netzlaufwerken achten  
'-----------------------------------------------------------------  
Dim DelNetDrive
Set WshNet = CreateObject("WScript.Network")  

For DriveAsc = 105 To 122
On Error Resume Next
DelNetDrive = Chr(DriveAsc) & ":"  
WshNet.RemoveNetworkDrive DelNetDrive, True, True 
next
On Error Goto 0



' Diese Funktion nutzt den IE zum erstellen eines Dialogfensters für Username und Password  
   Dim objIE
   ' Erstellen einen IE Objektes  
   Set objIE = CreateObject( "InternetExplorer.Application" )  
   ' Setzen der IE Einstellungen  
   objIE.Navigate "about:blank"  
   objIE.Document.Title = "Login Netzlaufwerke"  
   objIE.ToolBar        = False
   objIE.StatusBar      = False
   objIE.Resizable      = False
   objIE.Width          = 400
   objIE.Height         = 300
   ' Zentrieren des Dialogfensters auf dem Desktop  
   With objIE.Document.ParentWindow.Screen 
       objIE.Left = (.AvailWidth  - objIE.Width ) \ 2
       objIE.Top  = (.Availheight - objIE.Height) \ 2
   End With

    ' Erstellen des HTML-Codes für das Dialogfenster  
    objIE.Document.Body.InnerHTML = "<DIV align='center'><P>" & myPrompt _  
                                & "</P>" & vbCrLf _  
                                & "<div align='center'><P>" & myMessage _  
                                & "</P>" & vbCrLf _  
	                            & "<P>User: <INPUT TYPE='input' SIZE= '20'" _  
                                & "ID='Username'/></P>" & vbCrLf _  
                                & "<P>Password: <INPUT TYPE='password' SIZE= '20'" _  
                                & "ID='Password'></P>" & vbCrLf _  
                                & "<P><INPUT TYPE='hidden' ID='OK'" _  
                                & "NAME='OK' VALUE='0'/></p>" _  
                                & "<INPUT TYPE='submit' VALUE='OK'" _  
                                & "OnClick='VBScript:OK.Value=1'/></P></DIV>"  

    ' Sichbarkeit des IE Fensters  
    objIE.Visible = True

    ' Warten bis der OK Button gedrückt wurde  
    Do While 0 = objIE.Document.All.OK.Value
    	Wscript.Sleep 250
    Loop

' Lesen des Username und Password vom Dialogfenster  
getUsername  = objIE.Document.All.Username.Value
getPassword = objIE.Document.All.Password.Value


' Schließen des IE Scriptes  
objIE.Quit
Set objIE = Nothing



if getUsername = "user1" then  
' Verbinden der Netzlaufwerke für user1  

Set WshNetwork = WScript.CreateObject("WScript.Network")  
WshNetwork.MapNetworkDrive "w:", "\\homenas\verzeichnis 1", False, getUsername, getPassword   
end if

if getUsername = "user2" then  
' Verbinden der Netzlaufwerke für user2  

Set WshNetwork = WScript.CreateObject("WScript.Network")  
WshNetwork.MapNetworkDrive "t:", "\\homenas\verzeichnis 2", False, getUsername, getPassword   
end if



' Fehlerbehandlung  
' Netzlaufwerke wurden verbunden  
if Err = 0 then
msgbox "Netzlaufwerke wurden verbunden."  
else
select case Err.Number
case -2147024843
' Netzlaufwerke konnte nicht verbunden werden  
msgbox "Netzlaufwerke wurden nicht verbunden. Vielleicht ist das Ziel offline. Versuchen Sie es später nochmal"  
' Anmeldung fehlgeschlagen: Username oder Password falsch  
case -2147023570
msgbox "Netzlaufwerke wurden nicht verbunden: Username und/oder Password falsch."  
' Anmeldung fehlgeschlagen: Password falsch  
case -2147024810
msgbox "Netzlaufwerke wurden nicht verbunden: Password falsch."  
' Netzlaufwerk konnte nicht verbunden werden: Netzlaufwerke schon verbunden  
case -2147023677
msgbox "Netzlaufwerke sind schon verbunden."  
' anderer Fehler  
case else
msgbox "Teilen Sie den aufgetretenen Fehler dem Administrator mit: "& vbCrLf & vbCrLf & err.Number & vbCrLf & Err.Description  
end select
end if

Content-ID: 184821

Url: https://administrator.de/contentid/184821

Ausgedruckt am: 22.11.2024 um 02:11 Uhr

NetWolf
NetWolf 10.05.2012 um 20:21:47 Uhr
Goto Top
Moin Moin,

bei der Anweisung "On Error Resume Next" ist dir klar, was du dem Script sagst?
Ich übersetzte mal: Wenn ein Fehler auftritt mache einfach weiter, ohne den Fehler zu melden!

Auch die Anweisung läuft ins Leere: On Error Goto 0
Eine Sprungmarke mit 0 zu benennen ist nicht sinnvoll. Schlimmer noch, diese Sprungmarke gibt es gar nicht.

Alle Netzlaufwerke trennt man z.B. mit net use * /delete /yes (warum du das auch immer brauchst??)

Sorry, mir erschließt sich noch nicht der Sinn und Zweck des Scriptes. In Windows bist du mit Benutzername / Passwort angemeldet. Wenn du nun auf der NAS für diesen Benutzer entsprechende Rechte vergibst, kannst auch nur du an die entsprechenden Ordner.

Grüße aus Rostock
Wolfgang
(Netwolf)
bastla
bastla 10.05.2012 um 23:03:17 Uhr
Goto Top
@NetWolf
Auch die Anweisung läuft ins Leere: On Error Goto 0
Das hat den Sinn, nach dem angesprochenen "On Error Resume Next" wieder auf Standardfehlerhandling (also Abbruch mit Ausgabe des Fehlers) umzuschalten: On Error-Anweisung (Visual Basic)
Alle Netzlaufwerke trennt man z.B. mit net use * /delete /yes
Grundsätzlich ja - aber deswegen eine Shell aufrufen? Die Zeilen ab 9 tun's ja auch ...

Grüße
bastla
skyacer
skyacer 11.05.2012 um 19:17:55 Uhr
Goto Top
Hi,

das ich die Abfrage extra nicht so gewählt habe das er den Loginnamen nimmt ist deshalb so, weil die Loginnamen der PC sich von denen der auf den Nas unterscheiden. Ausserdem möchte ich nicht das er sich beim Anmelden gleich mit den jeweiligen Laufwerken verbindet sondern ich vorher auswählen möchte mit welchen Login. Hat alles schon seinen Hintergrund.


Hab vorher eine Batch gehabt aber es hat mich schon immer gestört das ich darin den User und das Password hinterlegen musste. War also eine unschöne Lösung.

Wär also schön wenn mit trotzdem jemand dabei helfen könnte bzw. die Fehler mir mal zeigt. bin was Scripten angeht noch blutiger Anfänger.

Grüße
mak-xxl
mak-xxl 12.05.2012 um 09:27:19 Uhr
Goto Top
Moin skyacer,

bis auf die oben besprochenen 'On Error ...' gibt es im WSH keine weiteren Sprungmarken. Der Aufbau des Scriptes lässt vermuten, dass Dir so etwas wie 'Goto Fehlerbehandlung' vorschwebte (der Block am Ende) - ist aber leider nicht möglich.

Alternativen sind:

  • 'While'- oder 'Do Loop'-Schleifen mit Eingabeüberprüfung solange, bis korrekter Wert eingegeben wurde zur Verhinderung von Fehlern im weiteren Ablauf;
  • vor der vermutlich fehlererzeugenden Zeile die Fehlerausgabe ausschalten ('... Resume Next'), danach eine komplette Fehlerbehandlung einbauen und Fehlerausgabe wieder einschalten ('... Goto 0');
  • Fehlerausgabe generell ausschalten und ein extra Sub (oder Function, falls Rückgabewerte gewünscht) erstellen, in dem eine komplette Fehlerbehandlung erfolgt. Diese(s) nach all den Zeilen rufen ('Call Fehlerbehandlung'), die einen Fehler verursachen [könnten].

Letzteres ist auch gleichzeitig ein Paradebeispiel für wiederverwendbaren Code ... face-smile

Viel Erfolg und freundliche Grüße von der Insel - Mario
skyacer
skyacer 12.05.2012 um 13:20:17 Uhr
Goto Top
Alternativen sind:

  • 'While'- oder 'Do Loop'-Schleifen mit Eingabeüberprüfung solange, bis korrekter Wert
eingegeben wurde zur Verhinderung von Fehlern im weiteren Ablauf;
  • vor der vermutlich fehlererzeugenden Zeile die Fehlerausgabe ausschalten ('... Resume Next'), danach eine
komplette Fehlerbehandlung einbauen und Fehlerausgabe wieder einschalten ('... Goto 0');
  • Fehlerausgabe generell ausschalten und ein extra Sub (oder Function, falls Rückgabewerte gewünscht) erstellen, in dem
eine komplette Fehlerbehandlung erfolgt. Diese(s) nach all den Zeilen rufen ('Call Fehlerbehandlung'), die einen
Fehler verursachen [könnten].


Und genau das kann ich eben noch nicht. Bin schon froh das ich den Teil oben hinbekommen habe aus Teilstücken. Könnte mir sonst jemand eben sowas erstellen??

Grüße
skyacer
skyacer 14.05.2012 um 10:28:36 Uhr
Goto Top
Hi,

hab das jetzt erstmal so gelöst. So wie es ausschaut funktioniert es. Ich hab nur ein Problem festgestellt. Starte ich das Skript und gebe alles ordnungsgemäß ein verbindet er mit die Laufwerke alle. Starte ich das ganze jetzt nochmal und gebe nur den Usernamen ein ohne das Kennwort verbindet er mir die Laufwerke auch. Das soll aber nicht so sein. Was muss ich also ändern damit dies auch noch beseitigt wird.

Grüße
Sky

'--------------------------------------------------------------------  
' Netzlaufwerke f: bis z: trennen Asc(f)=102 ...Asc(z)=122  
' ACHTUNG: auf Kleinschreibung bei Netzlaufwerken achten  
'-----------------------------------------------------------------  
Dim DelNetDrive
set WshNetwork = WScript.CreateObject("WScript.Network")  

For DriveAsc = 105 To 122
On Error Resume Next
DelNetDrive = Chr(DriveAsc) & ":"  

WshNetwork.RemoveNetworkDrive DelNetDrive, True, True 
next
on error goto 0

call IELogin ( getLoginName, getPassword) 

'Netzlaufwerke verbinden  
On Error Resume Next
If getLoginName = "User1" then  
'msgbox  "User: " & getLoginName & vbCrLf & "Password: " & getPassword  
WshNetwork.MapNetworkDrive "k:", "\\homenas\1", False, getLoginName, getPassword  
WshNetwork.MapNetworkDrive "l:", "\\homenas\2", False, getLoginName, getPassword  
WshNetwork.MapNetworkDrive "m:", "\\homenas\3", False, getLoginName, getPassword  
WshNetwork.MapNetworkDrive "n:", "\\homenas\4", False, getLoginName, getPassword  
WshNetwork.MapNetworkDrive "o:", "\\homenas\5", False, getLoginName, getPassword  
WshNetwork.MapNetworkDrive "p:", "\\homenas\6", False, getLoginName, getPassword  
WshNetwork.MapNetworkDrive "q:", "\\homenas\7", False, getLoginName, getPassword  
call error

elseIf getLoginName = "User2" then  
'msgbox  "User: " & getLoginName & vbCrLf & "Password: " & getPassword  
WshNetwork.MapNetworkDrive "k:", "\\homenas\1", False, getLoginName, getPassword  
WshNetwork.MapNetworkDrive "l:", "\\homenas\2", False, getLoginName, getPassword  
WshNetwork.MapNetworkDrive "m:", "\\homenas\3", False, getLoginName, getPassword  
WshNetwork.MapNetworkDrive "o:", "\\homenas\4", False, getLoginName, getPassword  
WshNetwork.MapNetworkDrive "p:", "\\homenas\5", False, getLoginName, getPassword  
call error

else 
msgbox "Netzlaufwerke wurden nicht verbunden: Username falsch oder nicht eingegeben"  
End If
On Error Goto 0


Function IELogin( getLoginName, getPassword) 
    Dim objIE
    ' Create an IE object  
    Set objIE = CreateObject( "InternetExplorer.Application" )  
    ' specify some of the IE window's settings  
    objIE.Navigate "about:blank"  
    objIE.Document.Title = "NetworkLogin" & String( 100, "." )  
    objIE.ToolBar        = False
    objIE.Resizable      = False
    objIE.StatusBar      = False
    objIE.Width          = 300
    objIE.Height         = 200
    ' Center the dialog window on the screen  
    With objIE.Document.ParentWindow.Screen
        objIE.Left = (.AvailWidth  - objIE.Width ) \ 2
        objIE.Top  = (.Availheight - objIE.Height) \ 2
    End With
    ' Wait till IE is ready  
    Do While objIE.Busy
        WScript.Sleep 200
    Loop
    ' Insert the HTML code to prompt for user input  
    objIE.Document.Body.InnerHTML = "<div align=""left"">" & vbcrlf _  
                                  & "<table cellspacing=""5""><tr nowrap>" _  
                                  & "<td>Username:</td><td>" _  
                                  & "<input type=""text"" size=""20"" " _  
                                  & "autocomplete=""off"" " _  
                                  & "id=""LoginName""></td></tr>" & vbcrlf _  
                                  & "<tr nowrap><td>Password:</td>" _  
                                  & "<td><input type=""password"" size=""21"" " _  
                                  & "id=""Password""></td>" & vbcrlf _  
                                  & "</tr></div></table>" & vbcrlf _  
                                  & "<div align=""center""><p><input type=""hidden"" id=""OK"" " _  
                                  & "name=""OK"" value=""0""> " _  
                                  & "<input type=""submit"" value="" OK "" " _  
								  & "onClick=""VBScript:OK.Value=1""> "_   
								  & "<input type=""hidden"" id=""Beenden"" name=""Beenden"" value=""0"">" _  
								  & "<input type='submit' value='Beenden' onClick=""VBScript:Beenden.Value=2""></p></div>"  
    ' Hide the scrollbars  
    objIE.Document.Body.Style.overflow = "visible"  
    ' Make the window visible  
    objIE.Visible = True
    ' Set focus on input field  
    objIE.Document.All.LoginName.Focus
	
	' Wait till the OK button has been clicked  
    On Error Resume Next
    Do While objIE.Document.All.OK.Value = 0 and objIE.Document.All.Beenden.Value = 0
        WScript.Sleep 200
		If Err or objIE.Document.All.Beenden.Value = 2 Then    'user clicked red X (or alt-F4) to close IE window  
             objIE.Quit
			 WScript.Quit
            Set objIE = Nothing
            Exit Function
			     End if
    Loop
    On Error Goto 0
	 
		    
    ' Read the user input from the dialog window  
   	getLoginName = objIE.Document.All.LoginName.Value
	getPassword = objIE.Document.All.Password.Value
	
	
	' Close and release the object  
    objIE.Quit
    Set objIE = Nothing
	
	
End Function

Function error
if Err =  0 then
msgbox "Netzlaufwerke wurden verbunden."  
else
select case Err.Number
case -2147024843
' Netzlaufwerke konnte nicht verbunden werden  
msgbox "Netzlaufwerke wurden nicht verbunden. Vielleicht ist das Ziel offline. Versuchen Sie es später nochmal"  
' Anmeldung fehlgeschlagen: Username oder Password falsch  
case -2147023570
msgbox "Netzlaufwerke wurden nicht verbunden: Username und/oder Password falsch."  
' Anmeldung fehlgeschlagen: Password falsch  
case -2147024810
msgbox "Netzlaufwerke wurden nicht verbunden: Password falsch."  
' Netzlaufwerk konnte nicht verbunden werden: Netzlaufwerke schon verbunden  
case -2147024811
msgbox "Netzlaufwerke sind schon verbunden."  
' anderer Fehler  
case else
msgbox "Teilen Sie den aufgetretenen Fehler dem Administrator mit: "& vbCrLf & vbCrLf & err.Number & vbCrLf & Err.Description  
end select
end if
End Function
mak-xxl
mak-xxl 14.05.2012 um 20:25:42 Uhr
Goto Top
Moin skyacer,

um zu überprüfen, dass hier nicht das gespeicherte Passwort vom IE weitergereicht wird, solltest Du selbiges testweise einmal löschen - ist es an dem, müsstest Du evtl. von dieser Eingabemaske abrücken oder getPassword bei Neuaufruf entladen (leeren). Als dauerhafte Lösung wäre eine Speicherung der ersten Ausführung des Scriptes in der aktuellen Sitzung in einer Umgebungsvariablen möglich, die, jedesmal abgefragt vom Script, zu der Entscheidung herangezogen werden kann, das Passwort erneut abzufragen oder neu zu verbinden oder die Verbindungen zu prüfen oder was auch immer.

Als 1. Tipp sei noch vermerkt, eigene Funktionen/Subs nicht so zu benennen wie reservierte Wörter der Programmierumgebung (i.e. 'error').
Der 2. Tipp betrifft das Rufen der Fehlerbehandlung (i.e. in Zeile 30):
- wenn die Zeile 28 einen Fehler verursacht, weil z.B. der verwendete Laufwerksbuchstabe nicht frei ist und
- wenn danach Zeile 29 einen Fehler verursacht, weil z.B. die verwendete Freigabe nicht erreichbar ist
wird, wenn mit Zeile 30 die Auswertung des Fehlers erfolgen soll, nur der letzte Fehler (i.e. Err.Number) behandelt werden, der vorhergehende wurde 'überschrieben'.
Ergo: Hinter jeder Zeile, die potentiell Fehler verursachen kann, wird die Fehlebehandlungsroutine gerufen! Damit aber nicht jedesmal die komplette Prüfung erfolgt, wird das nur getan, wenn ein Fehler aufgetreten ist, etwa so:

If Err.Number <> 0 Then Call ErrorHandler

Freundliche Grüße von der Insel - Mario
skyacer
skyacer 14.05.2012 um 22:40:12 Uhr
Goto Top
Danke erstmal für deine Hilfe/Anmerkungen. Könntest du mir dabei helfen bzw die entsprechenden zeilen eben umändern? Ich bin schon froh das ich das ohne große Probleme gelöst bekommen habe.

um zu überprüfen, dass hier nicht das gespeicherte Passwort vom IE weitergereicht wird, solltest Du selbiges testweise
einmal löschen - ist es an dem, müsstest Du evtl. von dieser Eingabemaske abrücken oder getPassword bei
Neuaufruf entladen (leeren). Als dauerhafte Lösung wäre eine Speicherung der ersten Ausführung des Scriptes in der
aktuellen Sitzung in einer Umgebungsvariablen möglich, die, jedesmal abgefragt vom Script, zu der Entscheidung herangezogen
werden kann, das Passwort erneut abzufragen oder neu zu verbinden oder die Verbindungen zu prüfen oder was auch immer.

Und wie um alles in der Welt entlade ich "getPassword" ?

Als 1. Tipp sei noch vermerkt, eigene Funktionen/Subs nicht so zu benennen wie reservierte Wörter der Programmierumgebung
(i.e. 'error').
Der 2. Tipp betrifft das Rufen der Fehlerbehandlung (i.e. in Zeile 30):
- wenn die Zeile 28 einen Fehler verursacht, weil z.B. der verwendete Laufwerksbuchstabe nicht frei ist und
- wenn danach Zeile 29 einen Fehler verursacht, weil z.B. die verwendete Freigabe nicht erreichbar ist
wird, wenn mit Zeile 30 die Auswertung des Fehlers erfolgen soll, nur der letzte Fehler (i.e. Err.Number) behandelt werden, der
vorhergehende wurde 'überschrieben'.
Ergo: Hinter jeder Zeile, die potentiell Fehler verursachen kann, wird die Fehlebehandlungsroutine gerufen! Damit aber nicht
jedesmal die komplette Prüfung erfolgt, wird das nur getan, wenn ein Fehler aufgetreten ist, etwa so:

If Err.Number <> 0 Then Call ErrorHandler

Das werd ich dann auch gleich mal so umsetzen. face-wink

Grüße Sky
mak-xxl
mak-xxl 15.05.2012 um 07:41:17 Uhr
Goto Top
Moin skyacer,


Zitat von @skyacer:
Und wie um alles in der Welt entlade ich "getPassword" ?

Zum Beispiel, in dem Du Zeile 108 nicht ausführst oder einen leeren Wert übergibst:

getPassword = ""
getPassword = Empty
' getPassword = ...

Freundliche Grüße von der Insel - Mario
skyacer
skyacer 15.05.2012 um 08:30:37 Uhr
Goto Top
Okay das Klingt einleuchtend. Aber das Problem ist ja dann das ich ja keine Übergabe des Passwortes mehr habe, ergo würde er auch keine Laufwerke verbinden. Also ist das nicht die optimalste Lösung.

Dann hab ich da noch eine Frage:
Wenn ich den Fehlerhändler hinter jede Zeile Beim Laufwerksverbinden einsetze würde ich ja bei jedem Fehler jeweils ein Fenster bekommen. Gibt es die Möglichkeit das der/die Fehler dann nur zum Schluss gebündelt in einem Fenster angezeigt werden?

Grüße
mak-xxl
mak-xxl 15.05.2012 um 14:10:34 Uhr
Goto Top
Moin skyacer,

Zitat von @skyacer:
Okay das Klingt einleuchtend. Aber das Problem ist ja dann das ich ja keine Übergabe des Passwortes mehr habe, ergo
würde er auch keine Laufwerke verbinden. Also ist das nicht die optimalste Lösung.

Was das Wort 'testweise' bedeutet ist aber klar? Ich dachte schon, Du wolltest eine Ursache finden ...

Wenn ich den Fehlerhändler hinter jede Zeile Beim Laufwerksverbinden einsetze würde ich ja bei jedem Fehler jeweils ein
Fenster bekommen. Gibt es die Möglichkeit das der/die Fehler dann nur zum Schluss gebündelt in einem Fenster angezeigt werden?

Wenn sich die Frage nach der Sinnfälligkeit solchen Tuns nicht stellt, kannst Du ein Array mit Fehlernummern (und dann aber auch Beschreibungen der verursachenden Zeile) erzeugen und je Zeile mit evtl. aufgetretenen Fehlern beladen lassen - das Ganze wertest Du zum Schluss aus.

Freundliche Grüße von der Insel - Mario
skyacer
skyacer 16.05.2012 um 08:17:26 Uhr
Goto Top
Hi,

deswegen fragte ich ja auch schon des öfteren wer mir dabei helfen könnte dies umzusetzen. Wenn ich wüsste wie man das macht würde ich ja nicht fragen ob mir jemand unter die Arme greifen könnte.

Könntest du mir nicht sonst mal das Skript oben eben umsetzen mit den Punkten die wir in den letzten 2-3 Threads besprochen hatte. Dann können wir das Thema auch endlich abschließen hier.

Danke und Grüße Sky
mak-xxl
mak-xxl 16.05.2012 um 12:45:51 Uhr
Goto Top
Moin skyacer,

bis jetzt hast Du mehrmals nach einer Detailänderung und Vorschlägen zur Abhilfe eines Fehlers gefragt - und genau das hast Du jedesmal bekommen.
Eine Lösung, die das Sammeln von Fehlern vornimmt, ist nicht besonders sinnvoll, da der Anwender dann auch nichts mehr ändern kann - besser ist hier, den ganzen Scriptablauf so anzupassen, dass potentielle Fehler abgefangen werden. Beispiele wären die Prüfung auf Erreichbarkeit einer Freigabe oder die Prüfung auf Verfügbarkeit eines Laufwerksbuchstabens etc.

Wenn die Fehler gesammelt werden sollen, dann etwa so:
Dim ErrArr(), i
Redim ErrArr(0)                                     ' beides an den Anfang des Scriptes

Nach jeder potentiell fehlererzeugenden Zeile folgenden Code einfügen:
If Err.Number <> 0 Then
    ErrArr(Ubound(ErrArr, 1)) = Err.Number          ' Err.Number speichern
    Redim Preserve ErrArr(Ubound(ErrArr, 1) + 1)    ' neuen Platz im Array schaffen
End If

An das Ende des Main-Blocks (Zeile 45/46) folgenden Block setzen:
For i = 0 to Ubound(ErrArr, 1) - 1                  ' -1 wg. letztem (unnötigen) Redim)
    Call ErrorHandler(ErrArr(i))
Next

Zeile 118 ändern in
Function ErrorHandler(ByRef FehlerNummer)           ' Fkt. bekommt bei Aufruf Wert übergeben

Zeile 119 ändern in
If FehlerNummer = 0 Then

Zeile 122 ändern in
Select Case FehlerNummer

Zeile 127 (Err.Description) wird nur die letzte Fehlerbeschreibung auswerfen (sie obigen Post), um das zu korrigieren, müsstest Du mehrere Arrays dimensionieren (da Preserve nur die höchste Dimension ändern kann) und diese entsprechend füllen und übergeben - diesen (absurden) Aufwand hast Du aber nicht, wenn Du nach jedem Fehler die Fehlerbehandlung aufrufst (siehe weiter oben gemachte Aussagen).

Freundliche Grüße von der Insel - Mario
bastla
bastla 16.05.2012 um 21:01:44 Uhr
Goto Top
@mario
Als Alternative zu den Arrays böte sich aber auch einfach je ein String mit Delimitern an (bei Bedarf ließen sich per "Split()") daraus auch nachträglich wieder Arrays machen) - allerdings finde ich das Ansinnen selbst auch nur bedingt sinnvoll ...

Grüße
bastla