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

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");

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

Datum und Kulturen

dattime.ToString("dd.mm.yyyy HH:mm", CultureInfo.InvariantCulture)
(mehr: http://groups.google.com/group/ microsoft.public.de.german.entwickler.dotnet.asp/ browse_thread/thread/0102785d04fa218a#)
(Leerzeichen entfernen!)

Zeile in DB-Tabelle zufügen

''' <summary>
''' fügt einer Tabelle eine neue Zeile zu und trägt die ID ein
''' </summary>
''' <param name="table">Die Tabelle</param>
''' <param name="ID">Wert des Schlüsselfeldes ID</param>
''' <param name="values">Datenwerte je nach Tabelle in der Feldreihenfolge der Tabelle</param>
''' <remarks>Dies ist nur möglich für Tabellen mit dem Feldnamen ID</remarks>
Public Sub DBInsert(ByVal tablename As String, ByVal ID As String, ByVal ParamArray values() As Object)

'baue die Werteliste und erkenne, wie viele Werte hineingehören
Dim valueList As New StringBuilder
For i As Integer = 0 To UBound(values, 1)
valueList.Append("'" & values(i) & "', ")
Next i
valueList.Remove(valueList.Length - 1, 2) 'schneide letztes Komma ab

'Erzeuge die Abfrage (Einfügen: ID, Werte, Pseudo-_TimeStamp)
Dim sqlText As String = String.Format("INSERT INTO [{0}] VALUES ('{1}', {2})", tableName, ID, values.ToString)
Dim acceptedRows As Integer
Try
acceptedRows = doSql(sqlText, QueryReturns.Value) 'Einfügen der Zeile
Catch ex As Exception
f = Format("Einfügen in Tabelle {0} fehlgeschlagen" & vbCrLf, tableName)
MsgBox(sqlText & vbCrLf & ex.Message)
Exit Sub
End Try
If acceptedRows = 0 Then
f = String.Format("Es konnte keine Zeile in Tabelle {0} eingefügt werden." & vbCrLf, tableName)
MsgBox( f & String.Format("Nicht eingefügte Werte für Key {0}: {1}", ID, values.ToString))
Exit Sub
End If
End Sub


--- alt ---

''' <summary>
''' fügt einer Tabelle eine neue Zeile zu und trägt die ID ein
''' </summary>
''' <param name="table">Die Tabelle</param>

''' <param name="ID">Wert des Schlüsselfeldes ID</param>
''' <param name="value1">und folgende: Datenwerte
''' je nach Tabelle in der Reihenfolge der Tabelle.
''' Für NULL-Wert Argument auslassen (nur Komma schreiben)</param>

''' <remarks>Dies ist nur möglich für Tabellen mit dem Feldnamen ID.</remarks>

Public Sub DBAddRow(ByVal table As TMserverDBTables, ByVal ID As String, _
Optional ByVal value1 As Object = Nothing, Optional ByVal value2 As Object = Nothing, _
Optional ByVal value3 As Object = Nothing, Optional ByVal value4 As Object = Nothing, _
Optional ByVal value5 As Object = Nothing, Optional ByVal value6 As Object = Nothing, _
Optional ByVal value7 As Object = Nothing, Optional ByVal value8 As Object = Nothing)

Dim f As String 'Hilfsstring
'Schließe die falschen Tabellen aus
Dim tableName As String = Enum.GetName(GetType(TMserverDBTables), table)
'erlaubte Tabelle?
If (table And 1) Or (table And 2) Then
f = "Tabelle " & tableName & " nicht als Argument zugelassen"
log.Fault("DBAddRow", f)
Exit Sub
End If

'baue die Werteliste
Dim values As New StringBuilder
values.Append(IIf(value1 Is Nothing, " NULL", " '" & value1 & "'"))
values.Append(IIf(value2 Is Nothing, ", NULL", ", '" & value2 & "'"))
values.Append(IIf(value3 Is Nothing, ", NULL", ", '" & value3 & "'"))
values.Append(IIf(value4 Is Nothing, ", NULL", ", '" & value4 & "'"))
values.Append(IIf(value5 Is Nothing, ", NULL", ", '" & value5 & "'"))
values.Append(IIf(value6 Is Nothing, ", NULL", ", '" & value6 & "'"))
values.Append(IIf(value7 Is Nothing, ", NULL", ", '" & value7 & "'"))
values.Append(IIf(value8 Is Nothing, ", NULL", ", '" & value8 & "'"))
'Erzeuge die Abfrage
Dim sqlText As String = "INSERT INTO '" & tableName & "' VALUES ('" & ID & "', " & values.ToString & ")"

Dim acceptedRows As Integer
Try
acceptedRows = doSql(sqlText, QueryReturns.Value) 'Einfügen der Zeile
Catch ex As Exception
f = Format("Einfügen in Tabelle {0} fehlgeschlagen", tableName) & vbCrLf
log.Fault("DBAddRow", f &amp; "ID: " & ID & " Values: " & values.ToString & vbCrLf & ex.Message)
Exit Sub
End Try
If acceptedRows = 0 Then
f = "Es konnte keine Zeile in Tabelle " &amp; tableName & " eingefügt werden." & vbCrLf
log.Fault("DBAddRow", f & String.Format("Nicht eingefügte Werte für Key {0}: {1}", ID, values))
End If
'fertig
log.Test("DBAddRow", String.Format("Eingefügte Werte für Key {0}: {1}", ID, values))
End Sub