Fehlerbehandlung VBA

Die Fehlerbehandlung soll so unaufdringlich wie möglich sein und vom eigentlichen Code möglichst nicht ablenken. Zugleich soll sie aber auch den Ort des Fehlers liefern.
Als zusätzliches Feature wird unterschieden zwischen "erwarteten" und anderen Fehlern. Erwartet sind Anwenderfehler udgl., die der Programmierer selbst mit Err.Raise wirft bzw. die in der Fehlerroutine speziell abgefangen werden. Erwartete Fehler zeigen nur den "geworfenen" Fehlertext ohne Angabe von Modul(Form/Report) und Control.



Hierzu gibt es zunächst die Prozedur ErrorBox.
Sie wird in einen geeigneten Modul gelegt (Allgemein oder Common könnte passen).

Public Sub Errorbox(Optional erwarteterFehlerText As String = "")
Dim n As String: n = Screen.ActiveForm.Name
Dim c As String: c = Screen.ActiveControl.Name
Dim s As String

If Err.Number = 10000 Then erwarteterFehlerText = Err.Description

If erwarteterFehlerText = "" Then
s = "Verzeihung! Das hätte nicht passieren dürfen." & vbCrLf & vbCrLf
s = s & "Fehler " & Err.Number & " in " & n & "." & c & vbCrLf & Err.Description
Else
s = erwarteterFehlerText
End If
If erwarteterFehlerText = "" Then
s = s & vbCrLf & vbCrLf _
& "Wenn Sie diesen Fehler nicht verstehen, informieren Sie bitte den Programmierer. Danke."
End If

MsgBox s, vbCritical + vbOKOnly, "Fehlermitteilung"
End Sub



Normale Anwendung in jeglicher Funktion/Prozedur











Private Sub irgendwas(...)
On Error GoTo Er
... 'der Code
Ex: Exit Sub
Er: Errorbox
Resume Ex
End Sub

Das Resume Ex kann auch noch weggelassen werden, wenn hinter Ex: nicht weitere Operationen stehen, die auch nach dem Fehlerfall ausgeführt werden sollen.
Übrigens: Den verwirrenden Quatsch, den Marken immer noch den Prozedurnamen beizufügen, kann man lassen. Ex: und Er: sind lokal und können immer wieder in jeglicher Prozedur verwendet werden.



Wie werfe ich irgendwo in meinem Code einen Anwendungsfehler?










... 'Code
Err.Raise 10000, , "Die Liste ist zum kompletten Markieren zu groß"
... 'Code

Die Fehlernummer 10000 ist reserviert und wird die Errorbox veranlassen, außer der Meldung keine "technischen" Informationen zu zeigen. Man kann natürlich auch einen Fehler mit einer anderen Nummer werfen, um den Ort mit angezeigt zu bekommen.
Übrigens: Zwar ist mir die 10000 verboten, aber wer kennt den Fehler, den Microsoft unter dieser Nr. meldet?

Wie verwende ich ErrorBox in der Fehlerroutine?









... 'Code
Ex: ...
Er:
If Err.Number = 5174 Then
Errorbox "Beim Öffnen des Worddokuments trat ein Fehler auf." _
& vbCrLf & "Das Dokument kann nicht gefunden werden."
Resume Ex
End If
'sonstige Fehler
Errorbox
Resume Ex
End Sub

Übrigens: Leider habe ich keinen Trick gefunden, den Namen der Prozedur zu ermitteln, aus welcher ErrorBox gerufen wird (und in welcher ja auch der Methodenname enthalten ist). Sollte einem der Leser dazu was einfallen, wird ihm die ganze VBA-Gemeinde dankbar sein.

Fehler 8155: Keine Spalte wurde für Spalte x von DRVD_TBL angegeben

System: Access 2003 (ADP mit SQL Server 2005)

Dies ist ein Hinweis auf eine fehlerhafte SQL-Anweisung.
Bei mir entstand der Fehler, als die SQL-Anweisung zusammengestückelt wurde:

DoCmd.RunSQL "INSERT INTO myTAB (Wert) VALUES (" & txtFeld & ")"

Alles geht gut, wenn in txtFeld eine ganze Zahl steht. Steht aber eine Kommazahl (z.B. 0,5) drin, dann erscheint in der VALUES-Liste das  Komma, was bedeutet: es werden zwei Werte statt einem übergeben.
Das Komma wird mit folgender Schreibweise korrekt in den SQL-Dezimalpunkt umgewandelt:

DoCmd.RunSQL "INSERT INTO myTAB (Wert) VALUES (" & str(txtFeld) & ")"

Web-Zugriff auf SQL Server

Der SQL Server 2005 erlaubt einer Web-Lösung (hier PHP) keinen Zugriff auf eine DB-Tabelle? Hier ein Beispiel für eine Fehlermeldung:

Warning: mssql_query() [function.mssql-query]: message: Die SELECT-Berechtigung wurde für das 'xxxx'-Objekt, 'yyyy'-Datenbank, 'dbo'-Schema verweigert. (severity 14) in C:\www\zzzz.php on line 26

Lösung:
Es gibt den speziellen Datenbankbenutzer *.IUSR_* (* für lokale Bezeichnungen). Diesen Benutzer muß man nicht selbst anlegen.
Über die Datenbankeigenschaften, Register Berechtigungen muß man ihm die Rechte für CONNECT, DELETE, INSERT, SELECT, UPDATE (soweit nötig) eintragen. Achtung, bei den Eigenschaften des Nutzers selbst ist das weder sichtbar noch möglich.

Hintergrund:
Der Nutzer IUSR - der bei Microsoft auch in anderen Kontexten existiert - ist speziell für anonyme Internetbenutzer gedacht, wie sie typischerweise bei Webbenutzung auftreten. Das heißt nicht, daß jeder Nutzer nun per DELETE einfach in der Datenbank irgendwas löschen kann, sondern nur, daß dies die Oberfläche darf, die der Nutzer benutzt. Nur wenn das PHP-(/ASP...)Programm von sich aus ein DELETE schickt, wird dies ausgeführt.
Beachten: die berühmte SQL-Injection (Es darf dem Benutzer nicht möglich sein, irgendwo einen SQL-Befehl einzutragen, der dann ungewollte Operationen ausführt - s. http://de.wikipedia.org/wiki/SQL-Injection).

In Datenherkunft von Formularen und Berichten Textteile austauschen

Bei Änderungen an der Datenbankstruktur sollen auch Tabellen- und Feldnamen geändert werden. In Modulen geht das einfach durch STRG + H (Ersetzen). Die in Access-Objekten eingebetteten SQL-Anweisungen werden so nicht erwischt. Hierzu folgende Funktion, die zweckmäßigerweise aus einem Makro (s. Abb.) aufgerufen werden kann.

Argumente:

1. oldString: das alte Textstück (z.B. "Länderschlüssel")
2. newString: das stattdessen einzusetzende (z.B. "Laenderschluessel")
3. findInForms: Ersetze in RecordSource jedes Formulars und Berichts (nur FALSE, falls nicht gewünscht)
   
4. findInControls: Ersetze in RowSource aller Listen- und Kombinationsfelder (nur FALSE, falls nicht gewünscht)

---

Public Function RenamePartInRSources(oldString As String, newString As String, _
Optional findInForms As Boolean = True, Optional findInControls As Boolean = True)
'ersetzt in der Datenherkunft von Form/Control ein Wort durch ein anderes
On Error GoTo Er
Debug.Print "Ersetze " & oldString & " durch " & newString
If oldString = "" Then Err.Raise 10001, , "Parameterfehler oldString"
If newString = "" Then Err.Raise 10002, , "Parameterfehler newString"
If Not (findInForms Or findInControls) Then Err.Raise 10003, , "Parameterfehler findIn*"

Dim AO As AccessObject
Dim F As Form
Dim R As Report

Dim o As String
Dim s As String
Dim i As Integer

For Each AO In Application.CurrentProject.AllForms
DoCmd.OpenForm AO.Name, acDesign, , , acFormEdit, acHidden
Set F = Forms(AO.Name)
If findInForms Then 'in Formular ersetzen
o = F.RecordSource
' Debug.Print F.Name & ": " & F.RecordSource
s = Replace(o, oldString, newString)
F.RecordSource = s
If s <> o Then Debug.Print F.Name & ": " & F.RecordSource
s = ""
End If

If findInControls Then 'in Steuerelement ersetzen
For i = 0 To F.Controls.Count - 1
On Error Resume Next
o = F(i).RowSource
' Debug.Print F.Name & "." & F(i).Name & ": " & F(i).RowSource
s = Replace(o, oldString, newString)
F(i).RowSource = s
If s <> o Then Debug.Print F.Name & "." & F(i).Name & ": " & F(i).RowSource
On Error GoTo Er
s = ""
Next i
End If
DoCmd.Close acForm, AO.Name, acSaveYes
Next AO

For Each AO In Application.CurrentProject.AllReports
DoCmd.OpenReport AO.Name, acDesign, , , acHidden
Set R = Reports(AO.Name)
If findInForms Then 'in Bericht ersetzen
o = R.RecordSource
s = Replace(o, oldString, newString)
R.RecordSource = s
If s <> o Then Debug.Print R.Name & ": " & R.RecordSource
s = ""
End If

If findInControls Then 'in Steuerelement ersetzen
For i = 0 To R.Controls.Count - 1
On Error Resume Next
o = R(i).RowSource
s = Replace(o, oldString, newString)
R(i).RowSource = s
If s <> o Then Debug.Print R.Name & "." & R(i).Name & ": " & R(i).RowSource
On Error GoTo Er
s = ""
Next i
End If
DoCmd.Close acReport, AO.Name, acSaveYes
Next AO
Ex:
Set AO = Nothing
Set F = Nothing
Set R = Nothing
Debug.Print "RenamePartInRSources beendet."
Exit Function
Er: MsgBox "Fehler " & Err.Number & " in Tools.RenamePartInRowSource" _
& vbCrLf & Err.Description
Resume Ex
End Function

Access-Formular: beim Datensatz bleiben

Donkarl.com 4.5 empfiehlt die Bookmark-Methode:
Me.Painting = False 'Bildschirmflackern reduzieren
... 'SQL o.a.
Dim v 'Variant
v = Me.Recordset.Bookmark
Me.Requery 'Requery zeigt normal den ersten Datensatz an
Me.Bookmark = v
Me.Painting = True

Die Suchmethode:
Me.Painting = False 'Bildschirmflackern reduzieren

... 'SQL o.a.

'nach Löschbefehl: auf nächste Zeile

'DoCmd.GoToRecord , , acNext

Dim pos As String

pos = txtDatenfeld

Me.Requery 'Das böse Requery

DoCmd.FindRecord pos, , , , , acAll

Me.Painting = True

Dann gibts auch noch Seek

und ev. DoCmd.GotoRecord Next

VBA in MS Office bringt "Unerwarteter Fehler"

Die Lösung
auf: http://www.herber.de/forum/archiv/716to720/t716089.htm
von: Christoph Dümmen
Geschrieben am: 07.01.2006 16:05:30

thanks to Tony Jollans in microsoft.public.word.vba.general

This sounds like corruption. If reinstalling Office doesn't help, try
deleting the VBA key in the registry (which is left unchanged by
(re)installation) ...

HKEY_CURRENT_USER\Software\Microsoft\VBA

If you delete this key, a clean copy should be created from built-in
defaults when you open the VBE.

Feldinhalt aufteilen, z.B. Straße und Hausnummer

Public Function PosHsNrInStrasse(Strasse As String) As Integer
    Dim Zaehler     As Integer
    Dim Laenge      As Integer
    Dim X           As String
    Dim Ergebnis    As String
   
    Laenge = Len(Strasse)
    PosHsNrInStrasse = 0
'von rechts nach links durch Strassennamen gehen
'bis auf die 3 linken Zeichen damit Strassen, die mit Zahl beginnen
'(z.B. 3. Terwestenweg) nicht als Hausnummer erkannt werden
    For Zaehler = Laenge To 3 Step -1
        X = Mid(Strasse, Zaehler, 1)         'aktuell zu prüfendes Zeichen
        If IsNumeric(X) Then                 'prüfen, ob Zeichen eine Zahl ist
            PosHsNrInStrasse = InStr(Strasse, X)            'Position der Zahl
        End If
    Next
End Function

Public Function HsNr(Strasse As String) As String
    Dim pos     As Integer
    Dim Laenge  As Integer
   
    pos = PosHsNrInStrasse(Strasse)
    Laenge = Len(Strasse)
    If pos > 0 Then
        HsNr = Right(Strasse, Laenge - pos + 1)
      Else
        HsNr = ""
    End If
   
End Function

Public Function StrName(Strasse As String) As String
    Dim pos     As Integer
    Dim Laenge  As Integer
   
    pos = PosHsNrInStrasse(Strasse)
    Laenge = Len(Strasse)
    If pos > 0 Then
        StrName = Trim(Left(Strasse, pos - 1))
      Else
        StrName = Strasse
    End If
 End Function

Quelle: Ludger auf  www.Office-Loesung.de

Aus VBA Word-Dokument erzeugen und darin Textmarken überschreiben

filesys:       Filesystemobjekt (vorher angelegt)
wdApp:         Word.Application-Objekt (vorher angelegt)
TEMPLATENAME:  Dateiname (inkl. Pfad) einer .DOT-Datei
STRINGCONTROL: Textbox o.a., enthält Name der Textmarke

...
'existiert die Dokumentvorlage? 
    Dim bEx As Boolean
    On Error GoTo Er
    If Not filesys.FileExists(TEMPLATENAME) Then
        MsgBox "Die Dokumentvorlage " & TEMPLATENAME & " wurde nicht gefunden."
        GoTo Ex
    End If
    On Error Resume Next
'prüfen, ob das Word-Objekt (noch) existiert
    Err.Clear
    bEx = wdApp.Documents.Count = 0
    If Err.Number = 462 Or Err.Number = 91 Then
        Set wdApp = Nothing
        Set wdApp = New Word.Application
        Resume
    ElseIf Err.Number > 0 Then
        GoTo Er
    End If
'erstelle das neue Dokument   
    On Error GoTo Er
    wdApp.Documents.Add TEMPLATENAME, False, wdNewBlankDocument, True

'ersetze Textmarke durch einen Text   
    With wdApp.Documents(wdApp.Documents.Count)  'das zuletzt angelegte Dokument
        On Error Resume Next
        .Visible = False
        'Beispiel: Eine Textmarke namens Firma wird überschrieben
        Dim bmString As String: bmString = STRINGCONTROL & ""
        bEx = .Bookmarks.Exists("Firma")
        If bmString & "" > "" And bEx Then
            wdApp.Selection.Goto what:=wdGoToBookmark, Name:="Firma"
            wdApp.Selection.TypeText Text:=bmString
        End If
...
    End With
'Zeige das Dokument an   
    wdApp.Selection.Goto wdGoToLine, wdGoToFirst
    wdApp.Visible = True
    wdApp.Activate
...
'Fehlerbehandlung
Ex: Exit Function
Er: MsgBox "Fehler " & Err.Number & " in NAMEOFPROCEDURE" _
    & vbCrLf & Err.Description
    Resume Ex
End...


nicht vergessen:

SET filesys=nothing
Set wdApp=Nothing

Die ausgewählten Items einer Listbox in String sichern

Public Sub SelectedFromStringToListBox(ByVal gesamtString As String, Liste As ListBox)
    On Error GoTo Er
    Dim v
    Dim i As Integer
    Dim j As Integer
    With Liste
        For Each v In .ItemsSelected
            .Selected(v) = False
        Next v
        v = Split(gesamtString, "; ")
        For i = 0 To UBound(v)
            For j = 0 To .ListCount - 1
                If v(i) = .ItemData(j) Then
                    .Selected(j) = True
                    Exit For
                End If
            Next j
        Next i
    End With
Ex: Exit Sub
Er: MsgBox "Fehler " & Err.Number & " in SelectedFromStringToListBox" _
    & vbCrLf & Err.Description
    Resume Ex
End Sub


Public Function SelectedFromListbox(ByVal Liste As ListBox) As String
    On Error GoTo Er
    Dim s As String
    Dim v
    s = ""
    For Each v In Liste.ItemsSelected
        If s > "" Then s = s & "; "
        s = s & Liste.ItemData(v)
    Next v
Ex:
    SelectedFromListbox = s
    Exit Function
Er: MsgBox "Fehler " & Err.Number & " in SelectedFromListbox" _
    & vbCrLf & Err.Description
    s = ""
    Resume Ex
End Function

Unterformular zeigt leeres Rechteck

Das Problem taucht in Accessprojekten (2002/2003) auf Basis SQL Server 2005 auf.

Die Datenherkunft darf in der ORDER BY-Klausel keine Bezeichnungen wie "XY.ID" enthalten. Erlaubt sind in dieser Klausel nur reine unqualifizierte Feldnamen wie "ID".

Hilfen:
Bearbeite die ORDER BY-Klausel für diesen Zweck in der SQL-Box, nicht per Abfrageassistent (er fügt den Tabellennamen bzw. -alias wieder zu).

Weise allen nicht eindeutigen Feldnamen, die in ORDER BY vorkommen, einen Alias zu und schreibe diesen hinter ORDER BY.

Notfalls eine Tabelle tabelle1 durch eine Unterabfrage ersetzen a la
...
FROM (Select ID as XYID, ... From tabelle1) AS XY
...

DTPicker zur Datumeingabe

Value kann nur eingegeben werden, wenn CheckBox auf True steht.

Value = Empty für das aktuelle Datum (als Voreinstellungswert?).

DTPicker1.CheckBox=False läßt die doofe Checkbox schließlich verschwinden.
(Achtung, die CheckBox-Eigenschaft kommt nicht in der Auswahlliste vor!)

---------------------------------------------------------
Praktische Anwendung:

a) DTPicker1 an kein Feld der Tabelle binden!
b) in Form.Current:
'Fülle den Picker mit dem Anfangswert
DTPicker1 .CheckBox = True
DTPicker1 = FeldAusDatenbank (oder Date oder was auch immer)
'kein NULL übergeben!
DTPicker1 .CheckBox = False
c) in DTPicker1_Exit:
'hat sich Wert geändert?
If FeldAusDatenbank = DTPicker1 Then Exit Sub
'schreib den neuen Wert zurück
FeldAusDatenbank = DTPicker1(oder was auch immer)
'eventuell nötig: Datensatz speichern
DoCmd.RunCommand acCmdSaveRecord

Audio-Applet

<html><head>

<title>AudioBox Sample</title></head><body>


<applet code="AudioBox.class" name="AudioBox" width=5 height=5>
<param name="ab0" value="sonar.au#babam.au#">
</applet>


<p>Press a button to play a sound.  Sounds will composite when overlapped.
<form>
   <input type="button" value="Sonar" onClick="AudioBox.playSoundtrack('sonar.au')">
   <input type="button" value="Babam" onClick="AudioBox.playSoundtrack('babam.au')">
</form>
Download: http://javaboutique.internet.com/AudioBox/
</body></html>

Drucken mit VBA

Dim view As Long, merk As String

Private Sub btnAnsicht_Click()
'Druckvorschau oder Ausdruck?
  If Me!btnAnsicht Then
    Me!btnAnsicht.Caption = "Ansicht"
    view = acPreview
  Else
    Me!btnAnsicht.Caption = "Drucken"
    view = acNormal
  End If
End Sub

Private Sub btnDruck_Click()
  DoCmd.OpenReport "rptTest", view
End Sub

Private Sub kmbDrucker_AfterUpdate()
'Ein Drucker wurde gewählt
Dim tmp As String
  tmp = Nz(Me!kmbDrucker, "")
  If tmp <> "" Then SetDefaultPrinter tmp
End Sub

Private Sub Form_Close()
'Standarddrucker setzen
  SetDefaultPrinter merk
End Sub

Private Sub Form_Load()
'alle Drucker in Kombifeld übernehmen
  btnAnsicht_Click
  Me!kmbDrucker.RowSource = GetWindowDeviceNames()
  merk = GetDefaultPrinterName()
  Me!kmbDrucker = merk
End Sub

Verbindung eines ADP zur Laufzeit festlegen

Folgende VBA-Prozedur weist dem ADP eine neue Verbindung zu:

Public Sub OpenADPConnection(ByVal strUser As String, ByVal strPassword As String)
Const strCONNECTION_STRING As String ="Provider=SQLOLEDB;Data Source=deinServer;Initial Catalog=deineDatenbank"
CurrentProject.OpenConnection strCONNECTION_STRING, strUser, strPassword
If Not CurrentProject.IsConnected Then
MsgBox "Es konnte keine Verbindung hergestellt werden!"
End If
End Sub

Unangenehmer Effekt:
Access versucht, beim Start einer Anwendung die letzte Verbindung wiederaufzubauen und endet nach Wartezeit mit einem Fehler.
Verhinderung:
Man sollte seine ADP-Anwendung ohne Verbindungsdaten ausliefern und dann, wie oben beschrieben, die Verbindung per VBA beim Start der Anwendung aufbauen.
Die gespeicherten Verbindungsinformationen kann man aus der Anwendung entfernen, indem man per VBA die OpenConnection-Methode ohne Parameter aufruft.

Call CurrentProject.OpenConnection


Danach ist das ADP beim Start verbindungslos und es wird nicht mehr automatisch versucht, eine Verbindung aufzubauen.

Spezialordner, Systemordner, Windowsordner

Option Compare Database
Option Explicit

'Define Special Folder Constants
Public Const CSIDL_PROGRAMS = 2 'Program Groups Folder
Public Const CSIDL_PERSONAL = 5 'Personal Documents Folder
Public Const CSIDL_FAVORITES = 6 'Favorites Folder
Public Const CSIDL_STARTUP = 7 'Startup Group Folder
Public Const CSIDL_RECENT = 8 'Recently Used Documents Folder
Public Const CSIDL_SENDTO = 9 'Send To Folder
Public Const CSIDL_STARTMENU = 11 'Start Menu Folder
Public Const CSIDL_DESKTOPDIRECTORY = 16 'Desktop Folder
Public Const CSIDL_NETHOOD = 19 'Network Neighborhood Folder
Public Const CSIDL_TEMPLATES = 21 'Document Templates Folder
Public Const CSIDL_COMMON_STARTMENU = 22 'Common Start Menu Folder
Public Const CSIDL_COMMON_PROGRAMS = 23 'Common Program Groups Folder
Public Const CSIDL_COMMON_STARTUP = 24 'Common Startup Group Folder
Public Const CSIDL_COMMON_DESKTOPDIRECTORY = 25 'Common Desktop Folder
Public Const CSIDL_APPDATA = 26 'Application Data Folder
Public Const CSIDL_PRINTHOOD = 27 'Printers Folder
Public Const CSIDL_COMMON_FAVORITES = 31 'Common Favorites Folder
Public Const CSIDL_INTERNET_CACHE = 32 'Temp. Internet Files Folder
Public Const CSIDL_COOKIES = 33 'Cookies Folder
Public Const CSIDL_HISTORY = 34 'History Folder

'Die Deklaration der API-Funktion (auch teils ohne das Schluß-A)
Declare Function SHGetSpecialFolderPathA Lib "SHELL32.DLL" ( _
ByVal hwnd As Long, _
ByVal lpszPath As String, _
ByVal nFolder As Long, _
ByVal fCreate As Long) As Long

'Liiefere den Pfad
Public Function GetSysPath(PType As Long) As String
On Error GoTo Er
Dim Pfadname As String ' API String Variable
Pfadname = Space(260)
If SHGetSpecialFolderPathA(0, Pfadname, PType, 0) <> 0 Then
Pfadname = Mid(Pfadname, 1, InStr(Pfadname, vbNullChar) - 1)
If Right(Pfadname, 1) <> "\" Then Pfadname = Pfadname + "\"
GetSysPath = Pfadname
End If
Ex:
Exit Function
Er: MsgBox "Fehler " & Err.Number & " in GetSysPath" _
& vbCrLf & Err.Description
Resume Ex
End Function

SQL Server CONVERT Datetime

Wandle das heutige Datum in Text um:

CONVERT(nvarchar, getdate(), x)

Dabei ergibt sich je nach x:

100: Jul 31 2008 11:49PM
101: 07/31/2008
102: 2008.07.31
103: 31/07/2008
104: 31.7.2008
110: 07-31-2008
112: 20080731
120: 2008-07-31 23:48:13

Eigene IP-Adresse ermitteln

myUser.IP = Request.UserHostAddress


Multicast-Adressen:

Dim lastServerIP As String = ""

Dim adapters As NetworkInterface() = NetworkInterface.GetAllNetworkInterfaces()
Dim adapter As NetworkInterface

'Ermittle die IP-Adressen des Rechners
For Each adapter In adapters
Dim adapterProperties As IPInterfaceProperties = adapter.GetIPProperties()
Dim multiCast As MulticastIPAddressInformationCollection = adapterProperties.MulticastAddresses
If multiCast.Count > 0 Then
Dim multi As IPAddressInformation
For Each multi In multiCast
If lastServerIP > "" Then lastServerIP &= " | "
lastServerIP &= multi.Address.ToString
Next multi
End If
Next adapter

Neustart nach Windows-Update verlängern

HKEY_LOCAL_MACHINE\ Software\ Policies\ Microsoft\ Windows\ WindowsUpdate\ AU

Einträge:
RebootRelaunchTimeoutEnabled = 1
RebootRelaunchTimeout = 720
(720 = 12 Stunden, beliebige Werte mögl.)

Stammdaten-Klasse

''' <summary>
''' Stammdaten zu allen möglichen Xxxxxs
''' </summary>
''' <remarks>ID ist XxxxxColor</remarks>
Public Class Xxxxxs
   ''' <summary>
   ''' Stammdaten zu einer möglichen Xxxxx
   ''' </summary>
   ''' <remarks>nicht zur externen Verwendung bestimmt - Zugriff nur über Class Xxxxxs</remarks>
   Public NotInheritable Class Xxxxx
      Private mImageName As String
      ''' <summary>
      ''' Name der Bilddatei ohne Extension
      ''' </summary>
      ''' <remarks>im Images-Ordner des Projekts; Standard: ".gif"</remarks>
      Public ReadOnly Property ImagePath(Optional ByVal Text As String = ".gif") As String
         Get
            Return "~/Images/" & mImageName & ext
         End Get
      End Property
      Private mText As String
      ''' <summary>
      ''' Textbeschreibung des Verbindungszustandes
      ''' </summary>
      ''' <value></value>
      ''' <returns></returns>
      ''' <remarks></remarks>
      Public ReadOnly Property Text() As String
         Get
            Return mText
         End Get
      End Property
      Friend Sub New(ByVal imageName As String, ByVal text As String)
         mImageName = imageName
         mText = text
      End Sub
   End Class
   ''' <summary>Sammlung der Xxxxxwerte</summary>
   Private Shared mXxxxxs As New Dictionary(Of XxxxxColor, Xxxxx)
   ''' <summary>
   ''' liefert zu einer XxxxxColor die übrigen Informationen
   ''' </summary>
   ''' <remarks>Default ist nicht möglich, drum immer .Item mitschreiben</remarks>
   Shared ReadOnly Property Item(ByVal XxxxxColor As XxxxxColor) As Xxxxx
      Get
         'müssen die Anfangsdaten eingetragen werden?
         If mXxxxxs.Count = 0 Then
            Dim ce As Xxxxx
            'wartet auf Verbindungsaufnahme
            ce = New Xxxxx("Xxxxxred", "Waiting for request")
            mXxxxxs.Add(XxxxxColor.Red, ce)
            'wartet auf Freigabe
            ce = New Xxxxx("Xxxxxyellow", "Waiting for Xxxxx")
            mXxxxxs.Add(XxxxxColor.Yellow, ce)
            'Verbindung besteht
            ce = New Xxxxx("Xxxxxgreen", "Connected")
            mXxxxxs.Add(XxxxxColor.Green, ce)
            'Verbindung nicht möglich
            ce = New Xxxxx("Xxxxxgrey", "Xxxxx impossible")
            mXxxxxs.Add(XxxxxColor.Grey, ce)
            'Kanäle zur Zeit ausgelastet
            ce = New Xxxxx("Xxxxxwhite", "All channels busy")
            mXxxxxs.Add(XxxxxColor.White, ce)
         End If
         'gib das gesuchte Objekt zurück
         Return mXxxxxs(XxxxxColor)
      End Get
   End Property
   Private Sub New()
      'soll nicht sichtbar sein -> keine Instanz nötig
   End Sub
End Class

CreateInstance: Unbekannte Objekte verwenden

Bekannt sind der NameSpace, der Name der enthaltenden Assembly und der
Name der Klasse(n). Die jeweiligen Klasse realisieren ganz verschiedene
Dinge (Objekte), doch muß eine einheitliche Schnittstelle eingehalten
werden. Die Anwendung benötigt nur die drei Namen als String für alle
Zugriffe.

a) Für alle Objekte verbindliche Schnittstelle:

Public Interface IInterfaceAllg
   Property Key() As String
   Property Parameter() As String
   ...
   Function Init() As Boolean
   Function Command(ByVal parameter As String) As String
   ...

b) In Assembly myAss1(.dll) beliebige Objekttypen (Beispiel):
Public Class myObj1 : Implements IInterfaceAllg
   Dim log As Log

   Private mKey As String
   Public Property Key() As String Implements IInterfaceAllg.Key
      Get
         Return mKey
      End Get

      Set(ByVal value As String)
         mKey = value
      End Set
   End Property
   Private mParameter As String
   Public Property Parameter() As String Implements IInterfaceAllg.Caption
   ...
   Public Function Init() As Boolean Implements IInterfaceAllg.Init
      MsgBox("Nichts ausgeführt in myObj1.Init. Key: " _
            & Key & " Parameter: " & parameter)
      Return False
   End Function
   Public Function Command(ByVal parameter As String) _
            As String Implements IInterfaceAllg.Command
      MsgBox("Nichts ausgeführt in myObj1.Command. Parameter: " & parameter)
      Return ""
   End Function
   ...

c) Allgemeines einhüllendes Objekt:
Public Class myHüllObjekt

   Private mObj As IInterfaceAllg
   Public Property myObj() As IInterfaceAllg 'BasicDevice
      Get
         Return mObjekt
      End Get
      Set(ByVal value As IInterfaceAllg)
         mObjekt = value
      End Set
   End Property
   ...

d) Erzeugen eines Hüllobjektes - realisiert Zugriff auf eine Klasse der Assembly(s):
   Gegeben: Dim drvNameSpace As String = "myNameSpace"
            Dim drvAssembly As String = "myAss1"
            Dim drvClass As String = "myObj1"
Diese Werte können aus einer Datenbank, Registry, XML-Datei usw. kommen und auch später erweitert werden.

   ...
   'ermittle die benötigten Assemblys
   Dim myAssemblys As New Dictionary(Of String, Assembly)
   For Each a As Assembly In My.Application.Info.LoadedAssemblies
      Select Case Left(a.FullName, 6)
         Case "myAss1"
            myAssemblys.Add("myAss1", a)
         Case "myAss2"
            myAssemblys.Add("myAss2", a)
      End Select
   Next
    
   Dim myAss As Assembly
   myAss = myAssemblys(drvAssembly)

   Dim o as myHüllObjekt

   Dim oh As Runtime.Remoting.ObjectHandle = _
      Activator.CreateInstance(myAss.FullName, _
         drvNameSpace & "." & drvClass)

   Dim dd As IInterfaceAllg = TryCast(oh.Unwrap(), IInterfaceAllg
   (  If dd Is Nothing Then...)
   
   o.myObj = dd

e) Arbeiten mit dem Objekt:

   o.myObj.Key = "Teil1"
   Dim retVal as Boolean
   retVal = o.myObj.Init()
   ...

Systemfarben

-2147483647 Desktop (background)
-2147483636 Hintergrund der Anwendung (appworkspace)

-2147483643 Fenster (window)
-2147483642 Fensterrahmen (windowframe)
-2147483638 Rahmen akt. Fenster (activeborder)
-2147483637 Rahmen eines inaktiven Fensters (inactiveborder)
-2147483640 Fenstertext (windowtext)
-2147483646 Titelleiste akt. Fenster(activecaption)
-2147483645 Titelleiste inakt. Fenster(inactivecaption)
-2147483639 Titelleistentext (captiontext)
-2147483629 Titelleistentext inakt. Fenster (inactivecaptiontext)

-2147483644 Menüleiste (menu)
-2147483641 Menütext (menutext)
-2147483648 Bildlaufleiste (scrollbar)
-2147483635 Hervorheben (highlight)
-2147483634 Text hervorheben (highlighttext)
-2147483631 Abgeblendeter (deaktivierter) Text (graytext)
-2147483625 QuickInfo-Text (infotext)
-2147483624 QuickInfo-Hintergrund (infobackground)

-2147483633 3D-Objekt, Front (buttonface)
-2147483630 Schaltfläche: Text (buttontext)
-2147483628 3D-Objekt, hervorgehoben (buttonhighlight)
-2147483632 3D-Objekt, Schatten (buttonshadow)
-2147483627 3D-Objekt, dunkler Schatten (threeddarkshadow)
-2147483626 3D-Objekt, hell (threedlightshadow)

(office.microsoft.com)

MsgBox überschreiben

Public Function MsgBox(strText As String, _
Optional intSymbol As VbMsgBoxStyle= vbOKOnly, _
Optional strTitel As String = "Anwendung") As VbMsgBoxResult

If Left(strText, 6) = "Fehler" And IsMissing(strTitel) Then
MsgBox = VBA.MsgBox(strText, intSymbol, strTitel & " - Fehlermitteilung")
Else
MsgBox = VBA.MsgBox(strText, intSymbol, strTitel)
End If
End Function

Hinweise:
Den Standardwert des optionalen Arguments strTitel (hier "Anwendung") passend ersetzen.
Wenn der Text mit dem Wort "Fehler" beginnt, erscheint ein entsprechender Titelleistentext (Falls keiner übergeben wurde).
Beachte: Mit VBA.MsgBox(... wird auf die originale MsgBox-Funktion zugegriffen.

EventLog - Ereignisprotokoll

In *.vb:

''' <summary>
''' Gibt Meldungen in die Ereignisanzeige (Anwendung) aus
''' </summary>
''' <param name="message">Die Nachricht</param>
''' <param name="type ">optionaler Parameter</param>
Private Sub WriteEventLog(ByVal message As String, Optional ByVal type As EventLogEntryType = EventLogEntryType.Information)
Try
' Create an EventLog instance and assign its source.
Dim myLog As New EventLog()
myLog.Source = "beliebig"
' Write an informational entry to the event log.
myLog.WriteEntry(message, type)
Catch ex As Exception
Exit Try
End Try
End Sub

Ergänzung:
Das Event Log ist in sog. Logs (Anwendung, System?) und Sources (Anwendungen) aufgeteilt. Während das generelle Schreiben in ein Event Log in ASP.NET generell erlaubt ist, werden für das Anlegen der Source administrative Rechte benötigt.

Folgender Code registriert eine Event Source (von einem Administrator ausführen):

EventLog.CreateEventSource("irgendwas", "meineAnwendung");

Danach können (von jedermann) Einträge geschrieben werden:

EventLog.WriteEntry("freiwaehlbar", "Mitteilung");

AJAX 1.0-enabled ASP.NET 2.0 program - Runtime Error

Fehler beim Zugriff auf die IIS-Metabasis

Das Konto, welches ASP.Net ausführt, hat im .Net FW keine Berechtigung, die Metabasis zu lesen. Normalerweise wird das bei der Installation von .Net automatisch gesetzt. Leider nur, wenn dann schon die IIS installiert sind. Wenn man IIS NACH .NET installiert, muß man das manuell machen:

Konsole: (als Admin? - weiß ich nicht) im Windows Verzeichnis:
>> cd Microsoft.Net\Framework\v2.0.'blabla'
>> aspnet_regiis -i -enable
Dann sollte es klappen :) [nach 2 Stunden Suche gefunden bei: http://groups.google.de/group/microsoft.public.de.inetserver.iis.asp/browse_frm/thread/9ad6ae63f302e82e/ce63891555a491a3?lnk=st&q=Fehler+beim+Zugriff+auf+die+IIS-Metabasis&rnum=1&hl=de#ce63891555a491a3]

Ereignis: Seite wurde geschlossen

Ein solches Ereignis gibt es leider nicht (und kann es nicht geben).
Um es annähernd zu simulieren, gehe ich folgendermaßen vor:
1) Das der Seite zugrundeliegende Objekt bekommt eine date-Eigenschaft LastContact
2) Die Seite läßt einen Timer laufen, in dessen Tick-Ereignis LastContact mit dem aktuellen Zeitstempel gefüllt wird. Der Trick: beim Schließen der Seite hört der Timer auf zu laufen und die Eigenschaft bleibt auf dem letztzugewiesenen Zeitstempel stehen.
3) Eine Serveranwendung läßt ebenfalls einen Timer laufen, in dessen Tick die LastContact-Eigenschaft mit der aktuellen Zeit verglichen wird. Wird ein Limit überschritten, dann ist bekannt, daß die Seite nicht mehr existiert.

Code:
1) die Eigenschaft:
Public Class Objekt
Private mLastContact As Date
Public Property LastContact() As Date
Get
Return mLastContact
End Get
Set(ByVal value As Date)
mLastContact = value
End Set
End Property
...
2) der Objekttimer:
ASPX:
<asp:Timer ID="Timer" runat="server" Interval="5000" />
ASPX.VB:
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
If not Page.IsPostBack Then
Timer.Interval = CycleTime
...
3) der Servertimer:
Private loopTimer As System.Timers.Timer
Private New(...
loopTimer = New System.Timers.Timer
AddHandler loopTimer.Elapsed, AddressOf OnTimedEvent
loopTimer.Interval = SERVERLoopTimerInterval
loopTimer.Enabled = True
' Der Timer läuft so lange diese Klasse besteht (wird praktisch nie beendet)
GC.KeepAlive(loopTimer)
...
End Sub
Private Sub OnTimedEvent(ByVal source As Object, ByVal e As System.Timers.ElapsedEventArgs)
'prüfe, ob Objekt als wartend eingetragen ist, obwohl nicht mehr aktiv
If (Now - obj.LastContact).Minutes * 60000 + _
(Now - obj.LastContact).Seconds * 1000 + _
(Now - obj.LastContact).Milliseconds >= 3 * CycleTime Then obj.istFrei...
End If
...
End Sub

Email aus Access

Public Sub °°EmailClick(adrFeld As String)
On Error GoTo Er
Application.FollowHyperlink "mailto:" & adrFeld
Ex: Exit Sub
Er: MsgBox "Bitte überprüfen Sie, ob es sich um eine korrekte Email-Adresse handelt."
Resume Ex
End Sub

multipart identifier ... could not be bound

Dies bezieht sich darauf, wenn ein Accessprojekt (ADP) auf einen SQL Server greift, den es  noch nicht kennt (z.B. Access 2003 auf SQL Server 2005).

Mit Multipart identifier ist sowas gemeint wie TabAlias.Feldname (A.ID oder so).
Der Fehler kommt aus dem SQL Server und folgende gefundene Hinweis lauten:
" Oh, yes - is there an IPCode yolumn in the dbo.ClassifiedAd table?
If so, then the optimizer might have processed the explicit join (... JOIN
ON ...) before the implicit one (FROM dbo.ClassifiedAd Ad, dbo.Objects O ...
WHERE ...)"
"Why are you mixing join types (old-style vs. ANSI)? Why do you not use the
alias prefixes on all of your columns? I'll try to re-write this so the
parser understands it, but I have no idea what your table structure looks
like, so I can't fix all the prefixes."
(s.http://www.dbtalk.net/microsoft-public-sqlserver-programming/multipart-identifier-304262.html)

Geholfen hat mir: Ohne Wizzards in der SQL-Anweisung die Tabellenaliase (auch vor den Feldnamen) zu entfernen. Im betreffenden Fall jedenfalls war das möglich ;-)

Nachtrag:
Es genügt, wenn in der ORDER BY- Klausel keine Tabellenqualifizierer stehen (ggf. Spaltenaliase verwenden)

Static in Klasse

Static-Variablen sind nur in Prozeduren erlaubt. Um sie über Prozedurgrenzen zu verwenden, kapsele ich diese in eine Funktion. Auf diese wiederum könnte bei Bedarf ein Property zugreifen. Diese "Variable" behält auch nach einem PostBack ihren Wert.

Function myName(Optional ByVal value As myType= Nothing) As myType
Static staticMember As myType= myStartwert
If value =Nothing Then Return staticMember
staticMember = value
Return value
End Function

Leseaufruf: x= myName
Schreibaufruf: myName(y)

(Es scheint, daß dies einen PostBack doch nicht überlebt)

For Each in Dictionary

Wenn das Dictionary beliebige Objekte enthält:

For Each s As String In myDict.Keys
x = myDict(s).member
...
'oder
Dim m as myObj=myDict(s)
x=m.member
...
Next

QueryString übernehmen (IFrame in DotNetNuke...)

myVar as String= My.Request.QueryString("VarNameInQueryString")
Beispiel:
Me.lblUser.Text = My.Request.QueryString("UserName")
Me.lblCaption.Text = My.Request.QueryString("UserFullName")

DotNetNuke: Reports mit ReportViewer