|
Tips & Tricks
Tips & Tricks, Wissenswertes und einfache Beispiele sollen beim Lernen der Erstellung von Anwendungen unter Microsoft Access XP unterstützen.
Veröffentlichter Programmcode dient auch als Vorlage bzw. Muster, damit er nicht immer wieder eingegeben werden muß. Bitte beachten Sie zu den zum Download bereit gestellten Inhalten die Nutzungsbedingungen.
|
Datensatzabhängiger Schreibschutz
Die kleine Beispielanwendung zeigt wie man mit datensatzabhängigen Kriterien Datensätze für die Bearbeitung sperren kann.
Download als gezippte Microsoft Access XP oder Acces 97 Datei!
|
|
Formularereignisse (Events)
Wann wird welches Ereignis im Formular aufgerufen. Die kleine Anwendung gibt Aufschluss über die Reihenfolge und bei welchen Ereignis welcher Events zündet.
Download als gezippte Microsoft Access XP oder Access97 Datei!
|
Dateihandling
Wie greife ich auf Dateien zu, und wie kann ich Verzeichnisse durchlaufen?
Function ListeVerzeichnis(Folder As String, WithSubFolders As Boolean, Optional Datei As String) As Long
Dim myDirResult As String, myFile As String, myTempFile As String, i As Long
If Right(Folder, 1) <> "\" And Right(Folder, 1) <> ":" Then
Folder = Folder & "\"
End If
If Datei > "" Then
myFile = Datei & Folder ' Dateiname und relativer Pfad
Else
myFile = Folder
End If
myDirResult = Dir(myFile & "*.*", vbDirectory)
Do While myDirResult <> ""
' Aktuelles und übergeordnetes Verzeichnis ignorieren.
If myDirResult <> "." And myDirResult <> ".." Then
' Ist myDirResult ein Verzeichnis?
If (GetAttr(myFile & myDirResult) And vbDirectory) = vbDirectory Then
' Verzeichnis erkannt?
' ---------------------
' Rekursiver Aufruf von ListeVerzeichnis bei [WithSubfolders = True]
If WithSubFolders Then
' Aktuelles myDirResult retten
myTempFile = myDirResult
'
' Verzeichnis gefunden
' ---------------------
Debug.Print "Verzeichnis:" & myDirResult
' Gesamtzahl der bearbeiteten Dateien hochzählen
i = i + ListeVerzeichnis(Folder & myDirResult, WithSubFolders, Datei)
' Altes Verzeichnis für aktuelle Bearbeitung wiederherstellen
' Doppeltbearbeitung wird dabei in Kauf genommen
myDirResult = Dir(myFile & "*.*", vbDirectory)
Do While myDirResult <> myTempFile
myDirResult = Dir
Loop
If myDirResult <> myTempFile Then
Debug.Print "FATAL ERROR in ListeVerzeichnis!"
Exit Function
End If
End If
Else
'
' Datei gefunden
' ---------------------
Debug.Print "Datei:" & myDirResult
i = i + 1
End If
End If
' Nächsten Eintrag abrufen.
myDirResult = Dir
Loop
' Rückgabe, Anzahl der Dateien
ListeVerzeichnis = i
End Function
Datenquelle in Visual Basic for Access (VBA) öffnen.
Wie öffne ich im Code eine Datenquelle der aktuellen Accessanwendung.
'
' Beispiel: Datenbanktabelle Artikel in Nordwind.mdb öffnen
'
' Zum Lesen, schreiben oder zur Neuanlage von Datensätzen durchlaufen
'
Sub TabelleDurchlaufen()
Dim rs As DAO.Recordset ' Recordsetobjekt aus DAO Zugriffsbibliothek
Dim sql As String ' Variable für Tabellenname oder SQL-Statement
' Datenbankquelle definieren
sql = "SELECT * FROM Artikel WHERE [Kategorie-Nr]=1 ORDER BY Artikelname;"
Set rs = CurrentDb.OpenRecordset(sql, dbOpenDynaset) ' dbOpenSnapshot für lesend
Do While Not rs.EOF ' Durchläuft alle Datensätze
' Anwendungsdaten lesen
Debug.Print rs!Artikelname
' Datensätze Ändern oder Hinzufügen
rs.Edit ' oder rs.AddNew für Neuanlage
rs!Einzelpreis = rs!Einzelpreis * (1.05) ' Beispiel, Preiserhöhung von 5%
rs.Update ' Änderungen werden geschrieben
rs.MoveNext ' Wichtig! Sonst unendlicher Schleifendurchlauf
Loop
rs.Close
If Not rs Is Nothing Then Set rs = Nothing ' Wichtig, Obj. aus Speicher entf.
End Sub
Verlaufsanzeige in der Statuszeile
Wie erstelle ich in der Statuszeile den Verlauf eines beliebigen Prozesses dar. Das Beispiel setzt voraus, dass die Statuszeile eingeblendet ist.
'
' Verlaufsanzeige in Statuszeile
'
' Voraussetzung: Stautuszeile muss bereits eingeblendet
' sein, damit der Verlauf sichtbar wird
'
Sub Verlaufsanzeige()
Dim i As Long, n As Long
' Anzahl der Durchläufe initialisieren
n = 20
' Verlaufsanzeige in Statuszeile initialisieren
SysCmd acSysCmdInitMeter, "Fortschritt", n
For i = 1 To n
' Verarbeitung (hier mit Timerbeispiel)
myTimer (0.2)
' Anzeige hochzählen
SysCmd acSysCmdUpdateMeter, i
Next i
' Verlaufsanzeige in Statuszeile ausblenden
SysCmd SYSCMD_REMOVEMETER
End Sub
Private Function myTimer(t As Single) As Boolean ' t=Dauer in Sekunden
Dim Start
Start = Timer ' Anfangszeit setzen.
Do While Timer < Start + t
DoEvents ' Steuerung an andere Prozesse abgeben.
Loop
myTimer = True
End Function
Daten aus Tabellen in eine Datei schreiben
Am Beispiel der Artikeltabelle aus der Nordwind Datenbank werden Datensätze datensatzweise in eine Datei geschrieben.
'
' Export der Artikeltabelle aus Nordwind in eine Datei
'
Sub Table2File()
Dim z As String, fd As String, zd As String, td As String
Dim Filename As String ' Ziel-Dateiname mit Pfad
Dim Tablename As String ' Name der Tabelle oder SQL-String
Dim rs As Recordset ' Recordset der Quelltabelle
Dim FileID As Variant ' ID für die zu erstellende Datei
Filename = "c:\Daten\Test\Artikel.csv" ' Pfad muss bereits existieren
Tablename = "Artikel"
td = """" ' Text-Delimiter (mit Textbegrenzungszeichen z.B.: " )
fd = ";" ' Feld-Delimiter (z.B.: Simikolon oder Komma)
zd = "" ' Zeilen-Delimiter (Ein Zeilenumbruch wird automatisch erstellt!
If Dir(Filename) > "" Then
If MsgBox("Datei " & Filename & " vorhanden! Überschreiben?", vbQuestion + vbYesNoCancel + vbDefaultButton2) = vbYes Then
Kill Filename
myTimer 0.5 ' Etwas warten
Else
Exit Sub
End If
End If
' Datenquelle als Recordset öffnen
Set rs = CurrentDb.OpenRecordset(Tablename, dbOpenSnapshot)
rs.MoveFirst
' DateiID initialisieren und öffnen
FileID = FreeFile
Open Filename For Output As FileID
' Alle Datensätze der Tabelle durchlaufen
Do While Not rs.EOF
' Datensatz auslesen
z = ""
z = z & rs![Artikel-Nr] & fd ' Artikel-Nr
z = z & td & rs!Artikelname & td & fd ' Artikelname
z = z & td & rs!Liefereinheit & td & fd ' Liefereinheit
z = z & rs!Einzelpreis & fd ' Einzelpreis
z = z & zd ' ggf. Satzendezeichen
' Hinweis: Wenn in den Texten Sonderzeichen vorkommen können
' wie z.B.: {", chr(13), chr(10)}
' sind diese in einer Funktion gesondert zu behandeln
' Datensatz in Datei schreiben
Print #FileID, z
' Nächsten Datensatz ansteuern
rs.MoveNext
Loop
' Dateien schließen
Close #FileID
rs.Close
Set rs = Nothing
End Sub
Private Function myTimer(t As Single) As Boolean ' t=Dauer in Sekunden
Dim Start
Start = Timer ' Anfangszeit setzen.
Do While Timer < Start + t
DoEvents ' Steuerung an andere Prozesse abgeben.
Loop
myTimer = True
End Function
Daten aus einer Datei in eine Tabelle schreiben
Am Beispiel der Artikeltabelle aus der Nordwind Datenbank werden Datensätze datensatzweise aus einer Datei in eine Tabelle der Nordwind Datenbank geschrieben. Erstellen Sie für dieses Beispiel eine leere Kopie der Artikeltabelle zum ausprobieren.
'
' Import einer Artikeltabelle aus einer Datei in die Nordwind-DB
'
Sub File2Table()
Dim z As String, s(5) As Variant, fd As String, zd As String, td As String, i As Long
Dim Filename As String ' Ziel-Dateiname mit Pfad
Dim Tablename As String ' Name der Tabelle oder SQL-String
Dim rs As Recordset ' Recordset der Quelltabelle
Dim FileID As Variant ' ID für die zu erstellende Datei
Tablename = "ArtikelZwei"
Filename = "c:\Daten\Test\Artikel.csv" ' Pfad muss bereits existieren
td = """" ' Text-Delimiter (mit Textbegrenzungszeichen z.B.: " )
fd = ";" ' Feld-Delimiter (z.B.: Simikolon oder Komma)
zd = "" ' Zeilen-Delimiter (Ein Zeilenumbruch wird automatisch erstellt!
If Not (Dir(Filename) > "") Then
MsgBox "Datei " & Filename & " nicht vorhanden!", vbExclamation
Exit Sub
End If
' DateiID der Quelldatei initialisieren und öffnen
FileID = FreeFile
Open Filename For Input As FileID
' Datenziel als Recordset öffnen
Set rs = CurrentDb.OpenRecordset(Tablename, dbOpenDynaset)
' Alle Datensätze der Tabelle durchlaufen
Do While Not EOF(FileID)
' Datensatz aus Datei lesen
Line Input #FileID, z
' Einfache Parserprozess, da es um den Dateiimport geht
i = InStr(z, fd): s(1) = Mid(z, 1, i - 1): z = Mid(z, i + 1)
i = InStr(z, fd): s(2) = Replace(Mid(z, 1, i - 1), """", ""): z = Mid(z, i + 1)
i = InStr(z, fd): s(3) = Replace(Mid(z, 1, i - 1), """", ""): z = Mid(z, i + 1)
i = InStr(z, fd): s(4) = Mid(z, 1, i - 1)
' Datensatz auslesen
rs.AddNew
rs![Artikel-Nr] = s(1) ' Artikel-Nr
rs!Artikelname = s(2) ' Artikelname
rs!Liefereinheit = s(3) ' Liefereinheit
rs!Einzelpreis = s(4) ' Einzelpreis
rs.Update
' Hinweis: Wenn in den Texten Sonderzeichen vorkommen können
' wie z.B.: {", chr(13), chr(10)}
' sind diese in einer Funktion gesondert zu behandeln
Loop
' Dateien schließen
Close #FileID
rs.Close
Set rs = Nothing
End Sub
|
)
)