Lordchens kleine Addressdatei 
So geht es genau:
Neues Projekt anlegen. In die Form folgendes einfügen:
-1- Listbox. Eigenschaft Sortieren = True
-15- Textboxen als Steuerelementefeld anlegen. Name: txt(0) ... txt(15)
-1- Commandbutton, Name = cmdNew
-1- Commandbutton, Name = cmdSave
-1- Commandbutton, Name = cmdSearch
-1- Commandbutton, Name = cmdDel
Es wurde festgestellt, dass entgegen SQL der Like Operator in VB nicht mit Variablen arbeitet  (kommt davon, wenn man zuviel mit SQL proggt).
Einiges war in der Tat wrong (kommt davon wenn man aus dem Kopf proggt).
Aber das nachfolgende ist getestet Den Code bitte in die Form einfügen,
und die Addressenverwaltung ist gebongt. Eines aber habe ich Dir überlassen:
Das Löschen von Datensätzen - na, wie könnte das wohl gehen mhm?
So jetzt eine kurze Erläuterung wie das Ding LoadDS (der Megatrick hier) genau funktioniert, das ist der Kamerad:
S = ConvertUDT(Addressen)
vErg = Split(S, ";") 'na Trickreich was :-)
For i = 0 To UBound(vErg) - 1 Step 2
txt(n) = Trim(vErg(i))
n = n + 1
NextWir haben in SaveALL an jedem Datenfeld ein ";Nr;" angehängt. Diese "Nr" sagt aus, zu welchem Textfeld die Daten gehören, Nr. 0 ... 15. Wir nehmen in Kauf,
dass wir in einigen Fällen die Daten etwas aufpeppeln müssen, nehmen dafür aber einen ungewöhnlichen Vorteil, der sich auch daraus ergibt, sehr gerne auf. Der Vorteil ergibt sich in der Funktion Split, die ";" ausfiltert und uns den String in ein Array zerlegt. Zunächst wird der gesamte UDT durch die Funktion ConvertUDT, mithilfe der API-Funktion RtlMoveMemory in einen Gesamtstring kopiert. Der String wird gesplittet und es entsteht in vErg ein Array, dass wie folgt vorliegt:
vErg(0) = 1
vErg(1) = 0
vErg(2) = CyberLord (Familienname)
vErg(3) = 1
vErg(4) = Hugo (Vornamen)
vErg(5) = 2
u.s.w.
Ello: Split splittet unsere Zusätze weg Nun steppt man in zweier Schritten durch das Array und lässt einen Zähler mitlaufen, so erhält man mit
dem Zähler die genaue Feldposition und kann die Daten zuweisen. Voila!
Genauso suchen wir auch. Wir lassen wieder das UDT in einen String zerlegen und suchen ganz einfach mit Instr nach dem Suchbegriff oder einem Teil davon.
Anbei der Code.
cu
Lordchen
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" _
(lpvDest As Any, _
lpvSource As Any, _
ByVal cbCopy As Long)
Private Type Adr
SatzNummer As String * 10
Name As String * 75
Vorname As String * 50
Strasse As String * 75
PLZ As String * 10
Wohnort As String * 75
Land As String * 50
Telefon_P As String * 15
Telefon_G As String * 15
Handy As String * 15
Fax As String * 15
MailAddresse As String * 125
HomePage As String * 255
Sonstiges As String * 255
Bemerkungen As String * 255
Formular As String * 10
End Type
Private Addressen As Adr
Private Sub SaveAll(Optional newSatzNr As Long)
Dim F As Byte
Dim DSNr As Long
Dim i As Integer
If txt(0).Text = "" Then
MsgBox "Speichern des Datensatzes ist nicht möglich.", vbExclamation, _
"Fehler"
Exit Sub
End If
For i = 0 To 15
With Addressen
Select Case i
Case 0
.SatzNummer = txt(i) & ";0;"
Case 1
.Name = txt(i).Text & ";1;"
Case 2
.Vorname = txt(i).Text & ";2;"
Case 3
.Strasse = txt(i).Text & ";3;"
Case 4
.PLZ = txt(i).Text & ";4;"
Case 5
.Wohnort = txt(i).Text & ";5;"
Case 6
.Land = txt(i).Text & ";6;"
Case 7
.Telefon_P = txt(i).Text & ";7;"
Case 8
.Telefon_G = txt(i).Text & ";8;"
Case 9
.Handy = txt(i).Text & ";9;"
Case 10
.Fax = txt(i).Text & ";10;"
Case 11
.MailAddresse = txt(i).Text & ";11;"
Case 12
.HomePage = txt(i).Text & ";12;"
Case 13
.Sonstiges = txt(i).Text & ";13;"
Case 14
.Bemerkungen = txt(i).Text & ";14;"
Case 15
.Formular = txt(i).Text & ";15;"
End Select
End With
Next
F = FreeFile()
On Error GoTo FileError
Open "Adressen.TXT" For Random As #F Len = Len(Addressen)
On Error GoTo 0
If newSatzNr > 0 Then
DSNr = newSatzNr
Else
DSNr = Val(txt(0).Text)
End If
'Datensatz speichern
Put #F, DSNr, Addressen
Close #F
Exit Sub
FileError:
MsgBox "Die Adressdatei konnte nicht gefunden oder geöffnet werden!", _
vbExclamation, "Dateifehler"
End Sub
Private Function ConvertUDT(oUDT As Adr) As String
Dim S As String
S = Space(Len(Addressen))
CopyMem ByVal S, oUDT, Len(Addressen)
ConvertUDT = S
End Function
Private Sub LoadDS(ByVal sNr As Long)
Dim vErg As Variant
Dim F As Byte
Dim n As Integer
Dim i As Long
Dim S As String
'Felder leeren
For i = 0 To 15
txt(i).Text = ""
Next
F = FreeFile()
On Error GoTo FileError
Open "Adressen.TXT" For Random As #F Len = Len(Addressen)
On Error GoTo 0
Get #F, sNr, Addressen
Close #F
S = ConvertUDT(Addressen)
vErg = Split(S, ";") 'na Trickreich was :-)
For i = 0 To UBound(vErg) - 1 Step 2
txt(n) = Trim(vErg(i))
n = n + 1
Next
Exit Sub
FileError:
MsgBox "Fehler beim Öffnen der Datei.", vbExclamation, "Dateifehler"
End Sub
Private Sub cmdDel_Click()
End Sub
Private Sub cmdNew_Click()
Dim F As Byte
For i = 0 To 15
txt(i).Text = ""
Next
F = FreeFile()
On Error GoTo FileError
Open "Adressen.TXT" For Random As #F Len = Len(Addressen)
If LOF(F) > 1 Then
txt(0).Text = (LOF(F) / Len(Addressen)) + 1
Else
txt(0).Text = 1
End If
Close #F
Exit Sub
FileError:
MsgBox "Fehler beim Öffnen der Adressdatei.", vbExclamation, "Fehler"
End Sub
Private Sub cmdSave_Click()
SaveAll
End Sub
Private Sub cmdSearch_Click()
Dim b As Byte, C As Byte
For i = 0 To 15
If txt(i).Text <> "" Then
b = b + 1
C = i
End If
Next
If b = 0 Then
MsgBox "Sie müssen einen Suchbegriff eingeben.", vbInformation, "Suchen" & _
"abgebrochen"
Exit Sub
End If
If b > 1 Then
MsgBox "Bitte nur einen Suchbegriff eingeben!", vbInformation, "Suchen" & _
"abgebrochen"
Exit Sub
End If
If Not FindDS(txt(C).Text) Then
MsgBox "Keinen Datensatz gefunden.", vbInformation, "Suchergebnis:"
End If
End Sub
Private Sub Form_Load()
Dim F As Byte
Dim DSNr As Long, i As Long, Nr As Long
Dim n As String, v As String
For i = 0 To 15
txt(i).Text = ""
Next
F = FreeFile()
On Error GoTo FileError
Open "Adressen.TXT" For Random As #F Len = Len(Addressen)
On Error Resume Next
'Satzanzahl ermitteln
If LOF(F) > 1 Then
DSNr = (LOF(F) / Len(Addressen))
Else
'Satz mit X keine DS vorhanden ;-(
Close #F
Exit Sub
End If
n = "": v = "": Nr = 0
For i = 1 To DSNr
Get #F, i, Addressen
n = Left(Addressen.Name, InStr(Addressen.Name, ";") - 1)
v = Left(Addressen.Vorname, InStr(Addressen.Vorname, ";") - 1)
Nr = Val(Left(Addressen.SatzNummer, InStr(Addressen.SatzNummer, _
";") - 1))
List1.AddItem n & vbTab & v
List1.ItemData(List1.ListCount - 1) = Nr
Next
Close #F
Exit Sub
FileError:
MsgBox "Fehler beim Öffnen der Datei.", vbExclamation, "Dateifehler"
End Sub
Private Sub List1_Click()
LoadDS List1.ItemData(List1.ListIndex)
End Sub
Private Function FindDS(ByVal sBegriff As String) As Boolean
Dim F As Byte
Dim DSNr As Long, i As Long, n As Long
Dim S As String
Dim m As String
FindDS = False
F = FreeFile()
On Erroro GoTo FileError
Open "Adressen.TXT" For Random As #F Len = Len(Addressen)
On Error GoTo 0
'Anzahl DS Ermitteln
If LOF(F) > 1 Then
DSNr = (LOF(F) / Len(Addressen))
Else
Close #F
Exit Function
End If
For i = 1 To DSNr
Get #F, i, Addressen
S = ConvertUDT(Addressen)
n = InStr(S, sBegriff)
If n > 0 Then
'Position checken
n = InStr(n, S, ";") + 1
m = Mid(S, n)
n = InStr(m, ";")
F = Val(Left(m, n - 1))
If txt(F).Text <> "" Then
FindDS = True
If FoundDS(Addressen) Then
Exit Function
End If
End If
End If
Next
Close #F
Exit Function
FileError:
MsgBox "Die Datei konnte nicht geöffnet werden.", vbExclamation, _
"Dateifehler"
End Function
Private Function FoundDS(oAdr As Adr) As Boolean
Dim jN As Variant
FoundDS = False
jN = MsgBox("Es konnte ein Datensatz gefunden werden." & vbCrLf & _
"Den Datensatz <" & _
Trim(oAdr.Name) & " " & Trim(oAdr.Vorname) & "> laden?", _
vbQuestion + vbYesNo, "Datensatz gefunden ...")
If jN = vbYes Then LoadDS Val(Left(Addressen.SatzNummer, InStr( _
Addressen.SatzNummer, ";") - 1))
jN = MsgBox("Beenden (JA) oder weitersuchen (NEIN)?", _
vbQuestion + vbYesNo, "Weitersuchen?")
If jN = vbYes Then FoundDS = True
End Function |
Forenübersicht Suchen Forumsregeln
Vol.6
November 2025
Sie sind aktuell nicht angemeldet.
