Datenerfassung mit Hilfe VON ... BIS

Question

Hallo ACCperten,

Ich meine dieses Mal ein anspruchsvolleres Thema gefunden zu haben :).

Und zwar haben wir für jede Maschine eine Seriennummer (Primärschlüssel, Format Text).

Es gehören aber n Maschinen zu einem Projekt (Format Text).

In den aller meisten Fällen sind die Seriennummern fortlaufend (1000, 1001,1002 usw.), so dass ich mir die Frage gestellt habe, ob es vielleich möglich ist eine Textbox VON und eine andere BIS zu nennen.

Dort würde ich z. B. 1000 und 1002 eintragen.

Kann man einen VBA Code so stricken, dass er über eine Schleife auch die 1001 einträgt und noch dazu gehörige Angaben mit einfügt?

Solche dazugehörigen Angaben sind z. B. Listenpreise, Rabatte, Frachtkosten (alles Zahlformat).

Alle Eingaben würden sich in einer Tabelle befinden.

Hintergrund meiner Anfrage ist, dass ein Projekt schnell über hundert Maschinen haben kann, und wenn ich die Eingaben für jeden Datensatz extra machen muss, habe ich gleich keine Lust mehr ;).

Ich hoffe, dass ich mein Anliegen klar beschrieben habe.

Vielen Dank für Eure Hilfe im Vorraus.

Peter.

Answer 1

Hallo Peter,
stimmt, Project ist ja eine Zeichenkette. Ich habe nur die Zahlen gesehen und irgendwann angenommen, dass es eine Zahl ist.
Deshalb muss es an der Stelle so aussehen:

rec1.Open "SELECT * from Tbl_KZ_Sales_Data " & _
WHERE Project='" & trim(Forms!frm_sales!From) & "'", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly

Das trim() entfernt Leerzeichen am Anfang und Ende der Zeichenkette.

Gruß
lorf

Answer 2

Hallo Lorf,

zunächst entschuldige ich mich für meine späte Antwort, aber ich war mal wieder unterwegs.

Ich habe auch mal meine Nase in die Bücher gesteckt und dabei folgenden Lösung gefunden, die auch gleich funktioniert hat.

Private Sub test()
On Error GoTo Err_Command10_Click

Dim rst As ADODB.Recordset
Dim conn As ADODB.Connection

Set rst = New ADODB.Recordset
Set conn = CurrentProject.AccessConnection

'Application.Forms("Form1").Controls("txtcocktail").Value = "Hiho"

rst.Open "table1", conn, adOpenKeyset, adLockOptimistic

If rst.Supports(adAddNew) Then
MsgBox ("hi")
End If

For ID = Forms!Form1!txtcocktail To Forms!Form1!txtend

With rst
If .Supports(adAddNew) Then
.AddNew
!Cocktail = ID
!qty = IIf(IsNull(Forms!Form1!txtqty), "0", Forms!Form1!txtqty)
!price = IIf(IsNull(Forms!Form1!txtprice), "0", Forms!Form1!txtprice)
.Update
End If
End With

Next ID

rst.Close

Set rst = Nothing



Exit_Command10_Click:
Exit Sub

Err_Command10_Click:
MsgBox Err.Description
Resume Exit_Command10_Click

End Sub

Was hälst Du davon?

Gruß

Peter

Answer 3

Hallo Peter,
ich habe nur noch eine Frage. Wie passt:
1.

dabei folgenden Lösung gefunden, die auch gleich funktioniert hat.

2.

!Cocktail = ID
!qty = IIf(IsNull(Forms!Form1!txtqty), "0", Forms!Form1!txtqty)
!price = IIf(IsNull(Forms!Form1!txtprice), "0", Forms!Form1!txtprice)

mit
3.

Name des Formulars: Frm_Sales
Name der Registerkarte: TabCtl0
Name der Tabelle: Tbl_KZ_Sales_Data

Namen der Textfelder: From, To (in diese Felder sollen die erste und die letzte Seriennummer rein), Project, Qty, List_price_per_unit_USD, Special_handling_costs_per_unit_USD, Estimated_freight_costs_per_unit_USD, Insurance_costs_per_unit_USD, Contracted_Value_per_unit_USD

aus Antwort 4 zusammen?

Oder bist du vielleicht schon beim nächsten Problem?

Ansonsten - nimm was funktioniert. ;-)
Gruß
lorf

Answer 4

Hallo Lorf,

das ist einfach zu erklären.

Wenn ich etwas Neues ausprobiere, baue ich mir immer einfache testdateien.

Und da ich mir die Lösung aus einem Accessbuch zusammengebaut habe, habe ich auch gleich die Bezeichnungen übernommen.

Deshalb steht da Cocktail z. B.

Abgewandelt habe ich das Makro dann in dem richtigen File, für den Du die Bezeichnungen hast. Also heißt Cocktail im richtigen File Bestellnummer.

Ist das Makro für Dich verständlich. Leider habe ich momentan keinen Serverzugang aber stelle Dir die abgewandelt Form nächste Woche noch mal rein.

Ohne Deine Hilfe wäre ich nie so weit gekommen. Du bist mein Held.

Gruß und ein schönes Wochenende.

Peter

Answer 5

Hallo lorf,

ich finde deine Lösung gelungen. Ich verstehe allerdings nicht warum du nicht zweimal cursorgesteuert die Recordset bearbeitest. Das Execute-Kommando verursacht höhere Kosten (was bei diesen Schleifenanzahlen wahrscheinlich zu vernachlässigen ist). Ich habe mal deinen Code entsprechend angepasst:

Private Sub data_entry_Click()
On Error GoTo Err_Data_Entry_Click

Dim rec1 As New ADODB.Recordset
Dim rec2 As New ADODB.Recordset

DoCmd.RunCommand acCmdSaveRecord

rec1.Open "SELECT * from Tbl_KZ_Sales_Data WHERE Project=" & _
Forms!frm_sales!from, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
rec2.Open "SELECT * from Tbl_KZ_Sales_Data ", CurrentProject.Connection, adOpenDynamic, adLockOptimistic

For prj = Forms!frm_sales!from + 1 To Forms!frm_sales!to
rec2.AddNew
rec2!Project = Str(prj)
rec2!qty = Nz(rec1!qty, 0)
rec2!List_price_per_unit_USD = Nz(rec1!List_price_per_unit_USD, 0)
rec2!Special_handling_costs_per_unit_USD = Nz(rec1!Special_handling_costs_per_unit_USD, 0)
rec2!Estimated_freight_costs_per_unit_USD = Nz(rec1!Estimated_freight_costs_per_unit_USD, 0)
rec2!Insurance_costs_per_unit_USD = Nz(rec1!Insurance_costs_per_unit_USD, 0)
rec2.Update
Next prj

Forms!frm_sales.Requery

Exit_Data_Entry_Click:
On Error Resume Next
rec1.Close
rec2.Close
Exit Sub

Err_Data_Entry_Click:
MsgBox Err.Description
Resume Exit_Data_Entry_Click

End Sub

Weiterhin habe ich den "acCmdSaveRecord" eingebaut, um zu verhindern, dass der aktuelle Datensatz nach der Erzeugnung wieder rückgängig gemacht werden kann. Das "requery" habe ich eingebaut, damit man auch den Erfolg direkt sieht.

Ich würde evtl. ein völlig ungebundes Formular nehmen und alle Werte aus dem Formular nehmen, statt aus rec1, das ist aber geschmackssache.
Was hältst du davon, Lorf?

Gruß
Ralf

Answer 6

@Peter:
das rst.Supports kannst du sicherlich weglassen, denn die Tabellen unterstützen das Einfügen.

@RaHi:
Du machst nunmal lieber immer alles mit VBA und das sieht auch immer recht professionell aus.
Meine Variante war eher darauf bedacht, so wenig VBA wie möglich zu benutzen um es
1. "einfach" zu halten und
2. um es portabel zu halten (vielleicht macht Peter mal was mit PHP und ODBC auf einem XAMPP-server oder mit Java und JDBC oder mit VC++, das kann ja auch ADO ...) und
3. weil SQL-Befehle ( hier INSERT) immer schneller sind als VBA (ist zumindest meine Meinung).

Das Argument das "Execute-Kommando verursacht höhere Kosten" kann ich deshalb nicht nachvollziehen und auch deshalb nicht, weil auch meine Variante erst die Daten in rec1 einliest und sie denn wie deine N-mal verteilt (eben nur mit INSERT).

"acCmdSaveRecord" hätte ich mir geschenkt, denn es gibt immer Hektiker, die erst klicken und denn denken und denn gerne rückgängig machen wollen.

Aber letzten Endes ist es Streit um Kaisers Bart, denn eigentlich interessieren in diesem Forum Geschwindigkeit und Kosten nicht . Hier geht es eigentlich nur um "geht" oder "geht nicht" bzw. "kann ich" oder "kann ich nicht".


Na gut, wie immer hat jeder eine andere Meinung und das waren meine 2 1/2 cent zum Samstagabend.

Denn bis demnächst
lorf

Answer 7

Hallo Lorf,

danke für Deine Hinweise. Ich habe mir nun ein paar Bücher zugelegt, die mir Eure Programmierungen verständlich gemacht haben.

Ich bedanke mich noch einmal für Deine ausdauernde Hilfe. Es hat mich dazu angespornt, mich mit Access noch weiter zu beschäftigen.

@ RaHi

Deine Lösung arbeitet gut bei mir und ich habe sie in ein anderes Makro eingebaut.

Public Sub test()

On Error GoTo Err_Command10_Click

'Declarations
Dim rst1 As ADODB.Recordset
Dim rst2 As ADODB.Recordset
Dim conn As ADODB.Connection

Set rst1 = New ADODB.Recordset
Set rst2 = New ADODB.Recordset


rst1.Open "Tbl_Specification_codes_accumulated", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
rst2.Open "Tbl_Specification_codes_separated", CurrentProject.Connection, adOpenDynamic, adLockOptimistic

Do While Not rst1.EOF
If IsNull(Len(rst1!Specifications)) Then
GoTo end1
Else
For start = 1 To Len(rst1!Specifications) / 4
rst2.AddNew
rst2!Order_ID = rst1!Order_ID
rst2!Order= rst1!Order
rst2!Base_Code = rst1!Base_Code
rst2!Specifications = Mid(rst1!Specifications, (start - 1) * 4 + 1, 4)
Next
End If
end1:
rst1.MoveNext
Loop

rst1.Close

Exit_Command10_Click:
Exit Sub

Err_Command10_Click:
MsgBox Err.Description
Resume Exit_Command10_Click

End Sub

Es geht darum, die Spezifikationscodes, die hier alle fortlaufend erfasst werden, zu vereinzeln.

Leider funktioniert es nicht wenn das Ergebnis von

Len(rst1!Specifications) / 4

eine ungerade Zahl ergibt z. B. 108/4=27.

In diesem Moment trägt das Makro nicht mehr den allerletzten Wert ein, obwohl dieser eindeutig noch erfasst wird.

Könnt Ihr mir da noch mal kurz helfen?

Gruß

Peter

Answer 8

Hallo Peter,

deine Funktion ist etwas "unsauber". Hier eine Korrektur mit ein paar Anmerkungen. An den Anfang des Moduls nimm bitte die Zeile

option Explicit

auf, die zwingt dich dazu jede Variable zu deklarieren und bewahrt dich vor bösen Tippfehlern.

Public Sub test()

On Error GoTo Err_Command10_Click

'Declarations
Dim start As Long ' Jede Variable deklarieren und "Option explicit" in den Kopf des Moduls!
Dim rst1 As ADODB.Recordset
Dim rst2 As ADODB.Recordset
'Dim conn As ADODB.Connection 'RaHi: auskommentiert, da nicht verwendet

Set rst1 = New ADODB.Recordset
Set rst2 = New ADODB.Recordset

rst1.Open "Tbl_Specification_codes_accumulated", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
rst2.Open "Tbl_Specification_codes_separated", CurrentProject.Connection, adOpenDynamic, adLockOptimistic

While Not rst1.EOF
If Not IsNull(rst1!Specifications) Then ' RaHi: goto-Programme sind schwer lesbar, also raus damit! Len (...) kann nicht NULL sein.
For start = 1 To Len(rst1!Specifications) / 4
rst2.AddNew
rst2!Order_ID = rst1!Order_ID
rst2!Order = rst1!Order
rst2!Base_Code = rst1!Base_Code
rst2!Specifications = Mid(rst1!Specifications, (start - 1) * 4 + 1, 4)
rst2.Update 'RaHi: ohne Update kein guter Weg!
Next
End If
rst1.MoveNext
Wend


Exit_Command10_Click:
'RaHi: im Exitbereich keine Fehlerbehandlung mehr zulassen, sonst kommst du in eine Endlosschleife
On Error Resume Next
rst1.Close ' RaHi: schließen der Recordsets auch im Fehlerfall sinnvoll
rst2.Close ' RaHi: ohne close geht es schief!
Exit Sub

Err_Command10_Click:
MsgBox Err.Description
Resume Exit_Command10_Click

End Sub

Prüfe mal, ob damit dein Problem gelöst ist.

Gruß
Ralf

Answer 9

RaHi,

ich bin Dir zu ewigen Dank verpflichtet :).

Es funktioniert absolut perfekt.

Ich danke Dir, Du hast den Tag gerettet.

Einen schönen Abend noch.

Peter