Ein Hallo an Alle 
Ich habe das Problem mit zahlreicher Hilfe von Euch und anderen lösen können.
Hier also nun der Code:
Option Explicit
Public File As String
Public File\_Path As String
Public File\_Name\_mdb As String
Public File\_Extension As String
Public Rubrik As String
Public adressat(11) As String
Public absender(6) As String
Public auftragsnummer(2) As String
Public auftragsdatum As String
Public angebot As String
Public komm As String
'
Public bestellung(21, 6) '20 Zeilen und 5 Spalten (Pos, Anzahl, Einheit, Beschreibung, Einzelpreis, Gesamtpreis)
'
Public netto As String
Public mwst As String
Public brutto As String
Public rabatt As String
Public skonto As String
Public lieferadresse As String
Public rechnungsadresse As String
Public lieferzeit As String
Public mdbfeld As String
Public mdbCount As Integer
Public strSQL As String
'
'Verbindung und Datensätze einrichten
'
Public mdbConnection As New ADODB.Connection
Public mdbRecordset As New ADODB.Recordset
Public mdbCmd As New ADODB.Command
Sub datenübernahme()
'
'Interne Variablen deklarieren
'
Dim i As Integer 'Schleifenvariable
Dim k As Integer 'Schleifenvariable
Dim a As String 'Antwort-Variable für MsgBox'en
'
'Daten aus dem Auftragsformular zusammentragen
'
'
'1. Adressat
'
'
'Auslesen des Adresskopfes
'gleichzeitig werden die Steuerzeichen enfernt
'
With ActiveDocument.Tables(1)
For i = 2 To 11
adressat(i) = .Cell(i, 1).Range
adressat(i) = Left(adressat(i), Len(adressat(i)) - 2)
Next i
End With
'
'2. Absender
'
'
'Auslesen des Absenders
'
With ActiveDocument.Tables(2)
absender(1) = .Cell(1, 1).Range
absender(2) = .Cell(2, 1).Range
absender(3) = .Cell(4, 2).Range
absender(4) = .Cell(5, 2).Range
absender(5) = .Cell(6, 2).Range
absender(6) = .Cell(7, 2).Range
End With
'
'Entfernen der Steuerzeichen
'
For i = 1 To 6
absender(i) = Left(absender(i), Len(absender(i)) - 2)
Next i
'
'3. Auftragsdatum
'
'
'Auslesen des Datums
'gleichzeitig werden die Steuerzeichen entfernt
'
With ActiveDocument.Tables(3)
auftragsdatum = .Cell(3, 6).Range
auftragsdatum = Left(auftragsdatum, Len(auftragsdatum) - 2)
'
'4. Auftragsnummer
'
'
'Auslesen der Auftragsnummer
'gleichtzeitig werden die Steuerzeichen entfernt
'
auftragsnummer(1) = .Cell(3, 1).Range
auftragsnummer(1) = Left(auftragsnummer(1), Len(auftragsnummer(1)) - 2)
auftragsnummer(2) = .Cell(3, 2).Range
auftragsnummer(2) = Left(auftragsnummer(2), Len(auftragsnummer(2)) - 2)
auftragsnummer(2) = auftragsnummer(2) & Right(auftragsdatum, 4)
End With
'
'5. Ihr Angebot vom/Nr.:
'
'
'Auslesen der Zeile
'gleichzeitig werden die Steuerzeichen entfernt
'
With ActiveDocument.Tables(4)
angebot = .Cell(1, 2).Range
angebot = Left(angebot, Len(angebot) - 2)
'
'6. Komm.:
'
'Auslesen der Zeile
'gleichzeitig werden die Steuerzeichen entfernt
'
komm = .Cell(2, 2).Range
komm = Left(komm, Len(komm) - 2)
End With
'
'7. Bestellpositionen 1 bis 20
'
With ActiveDocument.Tables(5)
For i = 2 To 21
For k = 1 To 6
bestellung(i, k) = .Cell(i, k).Range
bestellung(i, k) = Left(bestellung(i, k), Len(bestellung(i, k)) - 2)
Next k
Next i
End With
'
'8. Netto, MwSt. und Brutto
'
'
'Auslesen der Beträge
'
With ActiveDocument.Tables(5)
netto = .Cell(22, 3).Range
mwst = .Cell(23, 3).Range
brutto = .Cell(24, 3).Range
End With
'
'Bereinigen der Variablen um die Steuerzeichen
'
netto = Left(netto, Len(netto) - 2)
mwst = Left(mwst, Len(mwst) - 2)
brutto = Left(brutto, Len(brutto) - 2)
'
'9. Mengen / Sonderrabatt:
'
'
'Auslesen des Rabatts
'gleichzeitig werden die Steuerzeichen entfernt
'
With ActiveDocument.Tables(6)
rabatt = .Cell(1, 2).Range
rabatt = Left(rabatt, Len(rabatt) - 2)
End With
'
'10. Skonto
'
'
'Auslesen des Skonto
'gleichzeitig werden die Steuerzeichen entfernt
'
With ActiveDocument.Tables(7)
skonto = .Cell(1, 2).Range
skonto = Left(skonto, Len(skonto) - 2)
End With
'
'11. Anlieferungs / Arbeitsstelle:
'
'
'Auslesen der Lieferadresse
'gleichzeitig werden die Steuerzeichen entfernt
'
With ActiveDocument.Tables(8)
lieferadresse = .Cell(1, 2).Range
lieferadresse = Left(lieferadresse, Len(lieferadresse) - 2)
End With
'
'12. Rechnungsadresse:
'
'
'Auslesen der Rechnungsadresse
'gleichzeitig werden die Steuerzeichen entfernt
'
With ActiveDocument.Tables(9)
rechnungsadresse = .Cell(1, 2).Range
rechnungsadresse = Left(rechnungsadresse, Len(rechnungsadresse) - 2)
End With
'
'13. Lieferzeit:
'
'
'Auslesen der Lieferzeit
'gleichzeitig werden die Steuerzeichen entfernt
'
With ActiveDocument.Tables(10)
lieferzeit = .Cell(1, 2).Range
lieferzeit = Left(lieferzeit, Len(lieferzeit) - 2)
End With
'#######################################################################################
'#######################################################################################
'
'Übergabe der Daten an Access
'
'
'Verzeichnisse, Pfade und Dateinamen festlegen
'
File\_Path = "[Verzeichnis]"
File\_Name\_mdb = "auftrags\_statistik"
File\_Extension = ".mdb"
File = File\_Path & File\_Name\_mdb & File\_Extension
'
'Festellen, ob die Datenbank vorhanden ist.
'
If Dir(File) = "" Then
msgbox ("Die Statistikdatei " & Chr(10) & Chr(10) & File & Chr(10) & Chr(10) & "ist nicht vorhanden!")
End If
'
'Verbindung zur Datenbank herstellen
'
mdbConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & \_
"Data Source= " & File
'
'Prüfen, ob ein Datensatz mit der aktuellen Auftragsnummer(2) vorhanden ist.
'Wenn ja, wird dieser Datensatz gelöscht und neu geschrieben
'
'
'Tabelle ABSENDER (Haupttabelle der Löschweitergabe) ansprechen
'
mdbRecordset.Open "Absender", \_
mdbConnection, \_
CursorType:=adopenKeyset, \_
LockType:=adLockOptimistic
'
'Nach der Auftragsnummer(2) suchen
'
strSQL = "DELETE FROM Absender WHERE auftragsnummer2 = " & "'" & auftragsnummer(2) & "'" & ";"
mdbRecordset.Find "auftragsnummer2 =" & auftragsnummer(2)
If mdbRecordset.EOF Then
'msgbox "Datensatz nicht vorhanden!"
Else
If msgbox("Datensatz schon vorhanden! Löschen?", vbQuestion + vbDefaultButton2 + vbYesNo) = vbYes Then
mdbCmd.ActiveConnection = mdbConnection
mdbCmd.CommandText = strSQL
mdbCmd.Execute
Else
msgbox "Sie möchten den Datensatz nicht löschen. Das Programm wird jetzt beendet"
mdbRecordset.Close
mdbConnection.Close
Exit Sub
End If
End If
'
'Tabelle Absender schließen
'
mdbRecordset.Close
'
'Datenübergabe starten
'
'
'Tabelle ABSENDER ansprechen
'
mdbRecordset.Open "Absender", \_
mdbConnection, \_
CursorType:=adopenKeyset, \_
LockType:=adLockOptimistic
'
'Daten übertragen
'
With mdbRecordset
.AddNew
.Fields("auftragsnummer2") = auftragsnummer(2)
.Fields("absender1") = absender(1)
.Fields("absender2") = absender(2)
.Fields("absender3") = absender(3)
.Fields("absender4") = absender(4)
.Fields("absender5") = absender(5)
.Fields("absender6") = absender(6)
.Update
End With
'
'Tabelle ABSENDER schließen
'
mdbRecordset.Close
'
'Tabelle ADRESSAT ansprechen
'
mdbRecordset.Open "Adressat", \_
mdbConnection, \_
CursorType:=adopenKeyset, \_
LockType:=adLockOptimistic
'
'Daten übertragen
'
With mdbRecordset
.AddNew
.Fields("auftragsnummer2") = auftragsnummer(2)
.Fields("adressat2") = adressat(2)
.Fields("adressat3") = adressat(3)
.Fields("adressat4") = adressat(4)
.Fields("adressat5") = adressat(5)
.Fields("adressat6") = adressat(6)
.Fields("adressat7") = adressat(7)
.Fields("adressat8") = adressat(8)
.Fields("adressat9") = adressat(9)
.Fields("adressat10") = adressat(10)
.Update
End With
'
'Tabelle ADRESSAT schließen
'
mdbRecordset.Close
'
'Tabelle SONSTIGES ansprechen
'
mdbRecordset.Open "Sonstiges", \_
mdbConnection, \_
CursorType:=adopenKeyset, \_
LockType:=adLockOptimistic
'
'Datenübertragen
'
With mdbRecordset
.AddNew
.Fields("auftragsnummer1") = auftragsnummer(1)
.Fields("auftragsnummer2") = auftragsnummer(2)
.Fields("auftragsdatum") = auftragsdatum
.Fields("angebot") = angebot
.Fields("komm") = komm
.Fields("rabatt") = rabatt
.Fields("skonto") = skonto
.Fields("netto") = netto
.Fields("mwst") = mwst
.Fields("brutto") = brutto
.Fields("lieferadresse") = lieferadresse
.Fields("rechnungsadresse") = rechnungsadresse
.Fields("lieferzeit") = lieferzeit
.Fields("datei") = File\_Name\_doc
.Update
End With
'
'Tabelle SONSTIGES schließen
'
mdbRecordset.Close
'
'Tabelle BESTELLUNG ansprechen
'
mdbRecordset.Open "Bestellung", \_
mdbConnection, \_
CursorType:=adopenKeyset, \_
LockType:=adLockOptimistic
'
'Daten übertragen
'
With mdbRecordset
.AddNew
.Fields("auftragsnummer2") = auftragsnummer(2)
For i = 2 To 21
For k = 1 To 6
mdbfeld = "bestellung" & i - 1 & k
.Fields(mdbfeld) = bestellung(i, k)
Next k
Next i
.Update
End With
'
'Tabelle BESTELLUNG schließen
'
mdbRecordset.Close
'
'Verbindung zur Datenbank schließen
'
mdbConnection.Close
End Sub
Bedienen darf sich jeder an diesem Code
Gruß
Ralph
