Créer un nouveau dossier lors de l'enregistrer sur le bouton au lieu de remplacer MS-Access

Je pense que la réponse la plus simple serait de construire rapidement une macro en VBA - le code pour ajouter un nouvel enregistrement à une table est assez simple:

Private Sub cmdAddRecord_Click()
  Dim db As Database
  Dim rs As DAO.Recordset

  Set dbVideoCollection = CurrentDb
  Set rs = db.OpenRecordset("TableName") //<- Or a specific query in the parentheses.

  rs.AddNew
  rs("Column1").Value = "Blah"
  rs("Column2").Value = "Blah"
  rs("Column3").Value = "Blah"
  rs("Column4").Value = "Blah"
  rs("Column5").Value = "Blah"
  rs.Update
End Sub

Vous pouvez extraire les données à partir de la boîte de texte (ou quelle que soit l'entrée que vous utilisez) sur votre formulaire en ajoutant des variables et de la lecture des données, tels que:

strPnum = Me.txtPNum.Value

Voici le code que j'utilise pour un programme similaire - c'est plus complexe, mais son ajout des lignes en fonction de critères dans la base de données et de saisie dans le formulaire.

Private Sub Add()
''Add the Item to the Database
Dim Checker As Integer      ''Used to check if all of the essential information is present on the form
Dim strPNum As String       ''Hold's the Parent Item Value
Dim strSIM As String        ''Hold's the SIM number Value
Dim rs As DAO.Recordset     ''Used for the Routing table record set
Dim lrs As DAO.Recordset    ''Used for the Labor Code table record set
Dim db As Database          ''Database variable
Dim i As Integer
Dim OpDesc, LabCode, DBLRCodes(50), DBLRClong, DBLRDesc(50), a As String
Dim RoutSeq, LabHour, LabUnits, LRChecker, b, c As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("tblTestForRoutingInput")
Set lrs = db.OpenRecordset("tblLaborRateCodes")
Checker = 0
i = 1
''Debug.Print "For Cycling through manually."
''Verify that the essential fields have values.
If IsNull(Me.txtPNum.Value) Then
Checker = MsgBox("Please enter a value for the Parent Item Number", vbOKOnly, "Blank Parent Item Number")
ElseIf IsNull(Me.txtSIM.Value) Then
Checker = MsgBox("Please enter a value for the SIM number", vbOKOnly, "Blank SIM Number")
ElseIf Len(Me.txtSIM.Value) <> 11 Then
Checker = MsgBox("The SIM # must be 11 characters.", vbOKOnly, "Invalid SIM Number")
ElseIf IsNull(Me.txtStep1.Value) Then
Checker = MsgBox("Please enter at least ( 1 ) routing step.", vbOKOnly, "No Routing Steps")
End If
''If none of the essential fields are empty, proceed with the add.
If Checker = 0 Then
''Pull the Parent Item and SIM number values
strPNum = Me.txtPNum.Value
strSIM = Me.txtSIM.Value
''Search the table to see if the PNum or SIM already exists. If it does, end the function.
Do While Not rs.EOF
If rs("Parent_Item") = strPNum And Checker = 0 Then
Checker = MsgBox("Parent Item#: " + strPNum + " already exists in the database. If you wish to edit the item, please use the [Edit] screen.", vbOKOnly, "Item Already Exists")
i = 20
ElseIf rs("SIM") = strSIM And Checker = 0 Then
Checker = MsgBox("SIM#: " + strSIM + " already exists in the database. If you wish to edit the item, please use the [Edit] screen.", vbOKOnly, "Item Already Exists")
i = 20
End If
rs.MoveNext
Loop
''Determine the step to read in.
Do Until i = 20
If i = 1 Then
OpDesc = Me.txtStep1.Value
RoutSeq = Me.txtSeq1.Value
LabCode = Me.txtCode1.Value
LabHour = Me.txtHours1.Value
LabUnits = Me.txtUnits1.Value
ElseIf i = 2 Then ''I have a long string of If statement in the original code that are just used to get the data from the different text boxes but would take up another few hundred lines here.
End If
''If the current step has no data, end the function
If IsNull(OpDesc) Then
Checker = MsgBox("Item: " + strPNum + " has been added with (" + Str(i - 1) + ") Routing Steps", vbOKOnly, "Item Added")
i = 20
Else
''Define the variables to use for the Labor Rate Checker
LRChecker = 0
DBLClong = ""
b = 0
c = 1
''Check the entered Labor Rate Code against what is in the database, and pull the data into parallel arrays
Do While Not lrs.EOF
b = b + 1
If LabCode = lrs("Labor_Rate_Code") Then
LRChecker = 1
End If
DBLRCodes(b) = lrs("Labor_Rate_Code")
DBLRDesc(b) = lrs("Labor_Rate_Description")
lrs.MoveNext
Loop ''While Loop
''Compile the LR array data into 1 string for the Message Box
Do Until c > b
If DBLClong = "" Then
DBLClong = DBLRCodes(c) + " - " + DBLRDesc(c)
Else
DBLClong = DBLClong & vbNewLine & DBLRCodes(c) + " - " + DBLRDesc(c)
End If
c = c + 1
Loop ''Until Loop
lrs.MoveFirst
''If the Labor Rate code entered does not match one in the system, prompt the user to input a new code.
If LRChecker = 0 Then
LabCode = InputBox("The Labor Rate Code entered for Routing Step: " + Str(i) + " does not match any in the database. Please enter one of the following codes: " & vbNewLine & vbNewLine & DBLClong + ".", "Invalid Labor Rate Code", "Enter Code Here")
End If
''Add the new record into the DB
rs.AddNew
rs("Parent_Item") = strPNum
rs("Operation_Description") = OpDesc
rs("Routing_Sequence") = RoutSeq
rs("Labor_Code") = LabCode
rs("Labor_Hours") = LabHour
rs("Labor_Units") = LabUnits
rs("Quantity") = 10000
rs("SIM") = strSIM
rs("Effective_Date") = Date
rs.Update
i = i + 1
End If
Loop
''Close the recordsets
rs.Close
lrs.Close
End If
End Sub