Hier ein Lösungsweg:
Annahme: Datenbankdatei A und B mit gleichen Tabellen t_A und t_B. Wir möchten die Inhalte von t_B an t_A anfügen.
1) Erstelle eine Anfügeabfrage
, welche jene Felder aus t_B auswählt, die keine mehrwertigen Felder haben und auch keine Anlagenfelder. Diese kann dann einmal ausgeführt werden.Für die weiteren Schritte gehe ich davon aus, dass die Datensätze irgend eine Form von ID oder Schlüssel haben, sodass man sie eindeutig identifizieren kann.
2) Wie funktionieren für VBA mehrwertige Felder?
nehmen wir B1 als Recordset für t_B:set B1 = currentdb.openrecordset("t_B")
Und seit das mehrwertige Feld "mwfeld".
Wenn nun der zeiger des recordset B1 am gewünschten Datensatz ist, so erstellt man einen zweiten Recordsetz aus dem mwfeld:
set B2 = B1.fields("mwfeld")
Hierin sind nun die einzelnen Werte. Um sie durchzulaufen kann man folgende Schleife verwenden.
if B2.recordcount>0 then
B2.movefirst
do while not B2.eof
debug.print B2.fields(0) ' wir geben hier einfach mal den Wert aus
B2.movenext
loop
end if
Für alle Datensätze in t_A habe ich dann folgende Lösung: (gesamtes Listing am Ende)
(Schleife) Durchlauf der Datensätze von t_A als recordset
(Schleife) suchen des Datensatzes von t_B mit gleicher ID, Schlüssel odgl.
(Wenn gefunden)
(Schleife wie oben mit B1) für mwFeld in t_B, statt des debug.print fügen wir jeden Wert ein:
A2.add
A2.fields(0) = B2.fields(0)
A2.update
Achtung: einen gleichen Wert zwei Mal einfügen verursacht einen Fehler.
Den kann man sich ersparen, in dem man A2 vorher entleert:
If A2.RecordCount > 0 Then A2.Delete
3) Wie funkioniert das für VBA Anlagefelder?
Zuerst habe ich die Bilder aus der Quelltabelle t_B in ein Verzeichnis gespeichert. Als Dateinamen habe ich den Primärschlüssel verwendet.
Wiederum wird aus dem Feld selbst ein recordset (im recordset) erstellt.
Zentraler Code ist dann:
B2("FileData").SaveToFile (ordner & fn & "." & dt)
Damit wirddas Bild im Ordner ordner mit Dateinamen fn und Dateityp dt gespeichert.
Beim Einlesen wird zuerst das Verzeichnis eingelesen (hierzu ist der Verweis auf scripting runtime notwendig!
Es wird der zum Dateinamen -> ID/Schlüssel passende Datensatz gesucht, dann wiederum A2 als recordset gesetzt und dann mittels:
A2("FileData").LoadFromFile (bildordner & "\" & ab)
wobei ab der Bildname ist, der vorher beim Einlesen in ein Array gespeichert wird.
Hinweise zum Listing: die Feldnamen mit Umlauten waren schon vorgegeben - würde ich nicht so benennen. All das ist Q&D, aber es funktioniert.
Listing: Mehrwertige Felder
Public Sub append_t_datastart2_vba()
Const tq As String = "t_B"
Const tz As String = "t_A"
Dim rq As Recordset
Set rq = CurrentDb.OpenRecordset(tq)
Dim rz As Recordset
Set rz = CurrentDb.OpenRecordset(tz)
Dim r1 As Recordset
Dim r2 As Recordset
Dim fund As Boolean
Dim gefunden As Integer
gefunden = 0
rq.MoveFirst
Do While Not rq.EOF
such = rq.Fields("Primärschlüssel")
Debug.Print "beginne mit " & such
' Ziel einstellen
fund = False
rz.MoveFirst
If Not (IsNull(rz.Fields("Primärschlüssel"))) Then fund = (rz.Fields("Primärschlüssel") = such)
Do While Not fund
If Not (IsNull(rz.Fields("Primärschlüssel"))) Then fund = (rz.Fields("Primärschlüssel") = such)
If Not fund Then rz.MoveNext
Loop
If fund And rz.Fields("Primärschlüssel") = rq.Fields("Primärschlüssel") Then
gefunden = gefunden + 1
feld = "feldname1"
rz.Edit
Set r1 = rq.Fields(feld).Value
Set r2 = rz.Fields(feld).Value
If r2.RecordCount > 0 Then r2.Delete ' lösche alle Werte, falls vorhanden
r1.MoveFirst
Do While Not r1.EOF
x1 = r1.Fields(0)
Debug.Print x1
r2.AddNew
r2.Fields(0) = x1
r2.Update
r1.MoveNext
Loop
rz.Update
Else
Debug.Print "nicht gefunden"
End If
rq.MoveNext
Loop
Debug.Print "insgesamt gefunden " & gefunden
End Sub
Listing: Bilder auslesen und speichern
Sub Bilder_auslesen()
ordner = "M:\bilder\"
tabelle = "t_B"
Dim anzB As Integer
anzB = 0
Set db = CurrentDb
Dim r As Recordset2
Set r = db.OpenRecordset(tabelle)
Dim r2 As Recordset2
r.MoveFirst
Do While Not r.EOF
fn = r.Fields("Primärschlüssel")
Dim f As Field2
Set f = r.Fields("Foto")
Set r2 = f.Value
anz = r2.RecordCount
If anz > 0 Then
s = r2("FileName")
Debug.Print s
'dateityp
s = Right(s, 5)
s2 = InStr(s, ".")
dt = Right(s, Len(s) - s2)
r2("FileData").SaveToFile (ordner & fn & "." & dt)
anzB = anzB + 1
End If
r2.Close
r.MoveNext
Loop
anzd = r.RecordCount
MsgBox (anzB & " Bilder gespeichert von " & anzd & " Datensätzen")
r.Close
End Sub
Listing: Bilder einlesen
Sub bilder_einlesen()
' Verweis auf scrrun.dll nicht vergessen
Const tabelle As String = "t_A"
Dim bilder(1000) As String
z = 0
bildordner = "M:\bilder"
' Verzeichnis Dateinamen auslesen und in array bilder() schreiben
Dim fso_obj As Object
Dim fso_verz As Object
Dim fso_liste As Object
Dim fso_eintrag As Object
Set fso_obj = CreateObject("scripting.FileSystemObject")
Set fso_verz = fso_obj.GetFolder(bildordner)
Set fso_liste = fso_verz.Files
For Each fso_eintrag In fso_liste
z = z + 1
bilder(z) = fso_eintrag.Name
Next fso_eintrag
Debug.Print z & " Treffer"
treffer = 0
Set db = CurrentDb
Dim r As Recordset2
Set r = db.OpenRecordset(tabelle)
Dim f As Field2
Set f = r.Fields("Foto")
Dim r2 As Recordset2
For n = 1 To z
' für jedes Bild den Datensatz suchen
ab = bilder(n)
ps = Left(ab, InStr(ab, ".") - 1)
r.MoveFirst
Do While Not r.EOF
If r.Fields("Primärschlüssel") = ps Then
treffer = treffer + 1
Set r2 = f.Value
r.Edit
r2.AddNew
r2("FileData").LoadFromFile (bildordner & "\" & ab)
r2.Update
r2.Close
r.Update
End If
r.MoveNext
Loop
Next n
Debug.Print treffer & " zugeordnet"
End Sub
Keine Kommentare:
Kommentar veröffentlichen