Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1636to1640
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Von Excel auf Acces: Genauigkeitsangabe ungültig

Von Excel auf Acces: Genauigkeitsangabe ungültig
09.08.2018 21:16:59
Marco
Hallo,
ich arbeite an folgenden Projekt: Per Makro sollen aus Excel heraus vorgefertigten Datentabellen in eine Access-Datenbank kopiert werden. Dafür bediene ich mich folgenden Beispiel: http://www.datawright.com.au/excel_resources/excel_access_and_ado_part_1.htm
Im ersten Schritt will ich die Datenbank anlegen. Dafür muss ich obiges Beispiel bei zwei Aspekten anpassen:
1. Es müssen die richtigen Worksheets mit den Tabellen automatisch erkannt werden. Die richtigen Sheets fangen mit 'DB' an.
2. Es müssen die Feldnamen vom jedem 'DB'-Sheet automatisch ausgelesen und in access angelegt werden sowie das richtige Dateiformat. Die Datentabellen sind bereits im "access"-freundlichen Export-/Importformat (1. Reihe Feldnamen, ab 2. Reihe Werte, keine Sonderzeichen außer Unterstrich(_)).
Es sind insgesamt 29 Worksheets und 6 bis 21 Spalten, deshalb soll das anlegen etc über die Schleifen erfolgen.
Per Debug.Print konnte ich sehen, dass beim ersten Durchgang (also erste Tabelle) der Name der Tabelle richtig ist sowie die Feldnamen mitsamt Format.
Eine Fehlermeldung erhalte ich dann hier:

cat.Tables.Append tbl

Fehlermeldung:
"Laufzeitfehler '-2147217862(80040e3a)': Die Genauigkeitsangabe ist ungültig"
Ich konnte zu diesen Problem nichts finden, hoffe ihr könnt mir helfen.
Code:

Option Explicit
Const TARGET_DB = "DBxtra1001.accdb"
Sub CreateDB_And_Table()
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim sDB_Path As String
sDB_Path = ActiveWorkbook.Path & Application.PathSeparator & TARGET_DB
'delete the DB if it already exists
On Error Resume Next
Kill sDB_Path
On Error GoTo 0
'get all relevant database worksheet names (starting with DB)
Dim SheetNameCol As Collection
Set SheetNameCol = New Collection
Dim tempName As String
Dim j, i, k As Integer
j = 0
For i = 1 To Sheets.Count
tempName = Left(Sheets(i).Name, 2)
If tempName = "DB" Then
j = j + 1
SheetNameCol.Add Sheets(i).Name
End If
Next i
'create the new database
Set cat = New ADOX.Catalog
cat.Create _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & sDB_Path & ";"
Dim m, x, ColNumber As Integer
Dim temp1 As String
Dim temp2 As Variant
Dim FieldNameCol As Collection
Set FieldNameCol = New Collection
For m = 1 To SheetNameCol.Count
'create the table
Set tbl = New ADOX.Table
'give new access-table same name as in excel
tbl.Name = SheetNameCol(m)
'get number of fields of current excel-table
ColNumber = FieldNameNumber(SheetNameCol(m))
'get field names and determine data type
For x = 1 To ColNumber
'get field names
temp1 = ActiveWorkbook.Worksheets(SheetNameCol(m)).Cells(1, x).Value
FieldNameCol.Add temp1
'determine cell format
Set temp2 = ActiveWorkbook.Worksheets(SheetNameCol(m)).Cells(2, x)
tbl.Columns.Append FieldNameCol(x), FieldDataType(temp2)
Next x
'append the newly defined table to the Tables collection in the database
cat.Tables.Append tbl
Next m
Set cat = Nothing
'now create the primary key
'Call CreatePrimaryKey("tblTransationHistory", "Zeit-ID")
End Sub
Private Function FieldNameNumber(SheetNameCol As String) As Integer
FieldNameNumber = ActiveWorkbook.Worksheets(SheetNameCol).UsedRange.Columns.Count
End Function
Function FieldDataType(temp2 As Variant) As String
Select Case True
Case IsNumeric(temp2): FieldDataType = adNumeric
Case IsDate(temp2): FieldDataType = adDate
Case Else: FieldDataType = adVarWChar
End Select
End Function

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Von Excel auf Acces: Genauigkeitsangabe ungültig
10.08.2018 10:17:52
Robert
Hallo Marco,
ich habe nicht wirklich Ahnung, daher nur mal ein Schuß ins Blaue. Kann es vielleicht daran liegen, dass beim Anlegen der Datenfelder mit der Zeile
tbl.Columns.Append FieldNameCol(x), FieldDataType(temp2)

bei Textfeldern (Datentyp: adVarWChar) im Gegensatz zu dem von Dir genannten Beispiel auf der Seite datawright.com keine Angabe zur Datenfeldgröße gemacht werden?
Gruß
Robert
AW: Nachtrag
10.08.2018 10:47:55
Robert
Hallo,
ich habe hier noch etwas rumprobiert. Da ich Deinen Code mangels der Datentabelle nicht nehmen konnte, habe ich mal den Code von der Seite http://www.datawright.com.au/excel_resources/excel_access_and_ado_part_1.htm genommen und ein wenig damit gespielt. Meine erste Vermutung mit dem Datentyp adVarWChar war wohl falsch. Wenn ich die Größenangabe in dem Code rauslasse, wird halt ein Textfeld mit 255 Zeichen angelegt.
Den Fehler konnte ich aber reproduzieren. Und zwar tritt er dann auf, wenn ich in dem Code den anzulegenden Datentyp von adDouble auf adNumeric ändere. Vermutlich will er dann wissen, wieviel Dezimalstellen (vor und hinter dem Komma?) er anlegen soll. Wie das geschehen soll, kann ich allerdings nicht sagen. Versuche mal den entsprechenden Feldern in Deiner Funktion FieldDataType statt dem Datentyp adNumeric den Datentype adDouble zuzuordnen. Tritt dann der Fehler auch noch auf?
Gruß
Robert
Anzeige
AW: Nachtrag
10.08.2018 11:08:09
Marco
Hallo Robert,
ja, das war es, der Fehler ist nicht weiter aufgetaucht. Vielen Dank!
SG Marco
AW: Nachtrag
10.08.2018 11:15:51
Robert
Hallo,
danke für die Rückmeldung. Ich habe übrigens noch etwas weiter rumprobiert. In dem Code von der genannten Seite habe ich es geschafft einen Dezimal-Datentyp anzulegen. Dabei muss man dann in einer zweiten Codezeile die Genauigkeit angeben. In dem Beispielcode wäre das z. B. für eine Genauigkeitvon 10 Stellen:
tbl.Columns.Append "Yr_1950", adNumeric
tbl.Columns("Yr_1950").Precision = 10

Wenn Du lieber den Datentyp Dezimal statt Double hast, müsstest Du das irgendwie in Deinen Code einbauen.
Gruß
Robert
Anzeige
AW: Nachtrag
10.08.2018 12:04:14
Marco
Hallo Robert,
danke für den Nachtrag.Ich konnte den noch nicht ausprobieren, weil ich auf folgendes Problem gestoßen bin. Wie im Beispielcode rufe nun die Private Sub zum Festlegen einen Primärschlüssels auf. Das Makro läuft ohne Fehlermeldung. Bei der manuellen Kontrolle stellte ich aber fest, dass bei 5 der 29 Tabellen kein Primärschlüssel festgelegt wurde. Ein mehrmaliges Durchlaufen der Makro scheint den Eindruck zu bestätigen, dass es immer dieselben Tabellen sind. Daraufhin habe ich nochmal auf Rechtschreibung und Leertasten getestet, brachte aber keine Lösung. Zum Schluss bin ich das ganze Makro mit gedrückter F8-Taste durchgelaufen. Damit wurde aber das Problemen gelöst, daher alle Tabellen haben einen Primärschlüssel!?
Anzeige
Dein Problem ist ja...
10.08.2018 12:23:20
Case
Hallo, :-)
... gelöst. Ich poste Dir trotzdem mal noch zwei weitere Möglichkeiten, wie Du eine Accessdatenbank mit Tabelle und Spalten anlegen kannst: ;-)
Option Explicit
' Pfad- und Dateiname anpassen!!!!!!!!!!!!!!
Const strFileName As String = "C:\Temp\TestLast1.accdb"
Public Sub CreateDataBase()
Dim catCatalog As Object
Dim objTable As Object
Dim objIndex As Object
Dim objConn As Object
On Error GoTo Fin
'If Dir(strFileName)  "" Then Kill strFileName
Set objConn = CreateObject("ADODB.Connection")
Set catCatalog = CreateObject("ADOX.Catalog")
catCatalog.Create "Provider=Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=" & strFileName & ";"
With objConn
.CursorLocation = 3 ' = adUseClient
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Data Source") = strFileName
.Open
End With
Set objIndex = CreateObject("ADOX.Index")
Set objTable = CreateObject("ADOX.Table")
With objTable
.Name = "Lieferanten"
.ParentCatalog = catCatalog
.Columns.Append "Primaer", 3 ' = adInteger
With .Columns("Primaer")
.Properties("Description") = "Schluessel"
.Properties("Autoincrement") = True
End With
.Columns.Append "Name", 202, 60 ' 202 = adVarWChar
With .Columns("Name")
.Properties("Description") = "Nachname"
.Properties("Jet OLEDB:Allow Zero Length") = True
.Properties("Nullable") = True
End With
End With
catCatalog.Tables.Append objTable
With objIndex
.Name = "PrimaryKey"
.Columns.Append "Primaer"
.PrimaryKey = True
.Unique = True
End With
objTable.Indexes.Append objIndex
Fin:
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " (" & Err.Description & ")"
If Not objConn Is Nothing And objConn.State = 1 Then objConn.Close
Set objIndex = Nothing
Set objTable = Nothing
Set catCatalog = Nothing
Set objConn = Nothing
End Sub
Und: ;-)
Option Explicit
' Pfad- und Dateiname anpassen!!!!!!!!!!!!!!
Const strFileName As String = "C:\Temp\TestLast2.accdb"
Public Sub CreateDataBase_1()
Dim SQLCommand As String
Dim catCatalog As Object
Dim objConn As Object
On Error GoTo Fin
'If Dir(strFileName)  "" Then Kill strFileName
Set objConn = CreateObject("ADODB.Connection")
Set catCatalog = CreateObject("ADOX.Catalog")
catCatalog.Create "Provider=Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=" & strFileName & ";"
With objConn
.CursorLocation = 3 ' = adUseClient
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Data Source") = strFileName
.Open
End With
SQLCommand = "CREATE TABLE Daten (ID AUTOINCREMENT PRIMARY KEY, Suchnr VARCHAR, " & _
"Zeichnungsnr VARCHAR, Sachnr CHAR(6), " & _
"Lagerort VARCHAR, Stk INT,Material VARCHAR, " & _
"Bezeichnung VARCHAR, Filename VARCHAR, Zugriffsjahr INT)"
objConn.Execute (SQLCommand)
Fin:
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " (" & Err.Description & ")"
If Not objConn Is Nothing And objConn.State = 1 Then objConn.Close
Set catCatalog = Nothing
Set objConn = Nothing
End Sub
Servus
Case

Anzeige
AW: Dein Problem ist ja...
10.08.2018 16:09:56
Marco
Hallo Robert,
vielen Dank nochmal für die erweiterte Lektüre :).
Konnte mein Problem dauerhaft lösen. Anstatt die Private Sub aufzurufen haben ich nur die 5/6 Zeilen in meine vorhandene Schleife eingefügt. Hat auch enorm die Geschwindigkeit gesteigert.
SG Marco

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige