2013-05-07 98 views
1

我有一個窗體與一個綁定到一個表的一個combox框和一個文本框,還有一個表顯示內容和一個按鈕來保存reocrd。當點擊保存按鈕而不是覆蓋時創建新記錄MS-Access

我想知道如何在保存按鈕被點擊時如何創建新記錄而不是覆蓋當前的記錄?

我目前正在使用一個具有RunCommand SaveRecord和Refresh來更新表的宏。

我需要使用vba代碼來實現我所看到的嗎?

enter image description here

+0

你能告訴我們你目前的代碼嗎? – Raptor 2013-05-07 09:59:44

+0

要小心主鍵。 – matzone 2013-05-07 10:01:00

+0

主鍵是爲每條記錄自動生成的。我實際上沒有任何代碼使用嵌入式宏進行clcick事件。我在問題中插入了一個截圖。 – Bawn 2013-05-07 10:13:08

回答

7

我認爲最簡單的答案是建立在VBA快速宏 - 一個新的記錄添加到表中的代碼非常簡單:

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 

可以拉取數據從文本框(或任何輸入您正在使用)表單上通過增加變量和讀取數據,如:

strPnum = Me.txtPNum.Value 

這裏是我我們的代碼爲一個類似的程序 - 它更復雜,但它根據數據庫中的條件添加行並在表單上輸入。

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 
+0

我剛剛意識到這是在開始時創建1個額外的記錄,然後更新到最後添加的記錄。任何想法如何擺脫這一點?我已經嘗試取出。更新和沒有運氣 – Bawn 2013-05-13 15:23:51

+0

我在一個ACCESS數據庫中使用了一個類似的宏,我沒有看到同樣的事情發生。您可以嘗試在'AddNew'命令之前添加'rs.MoveLast'。我將上傳我使用的代碼,以便您可以查看它。 – andrewmours 2013-05-15 14:25:50

+0

@andrewmours我認爲你的方法工作,如果表單沒有綁定,否則,它會自動創建一個新的記錄。 – user3781528 2016-07-11 00:54:05