Copy specific fields to another record 1

[rbertram]

I have a form that moves someone from one office to another. The form a combo box for the persons ID ([EmailID])and their new location ([NewLocation]) limited to only available locations.

Below it the code I currently have, but I have not been able to figure out how to copy other fields ([Phone] and [Analog Line]) from the current record to the new record without asking for the information in the form. I know that I am not currently deleting these entries from the old location. This is because I am leaving it in until I solve this problem.

DoCmd.SetWarnings (False)

DoCmd.RunSQL ("UPDATE tblOffice SET tblOffice.EmailID = Null, tblOffice.Available = -1 WHERE (tblOffice.EmailID)=Forms!frmMoveLocation!EmailID;")

DoCmd.RunSQL ("UPDATE tblOffice SET tblOffice.EmailID = [Forms]![frmMoveLocation]![EmailID], tblOffice.Available = 0 WHERE (tblOffice.[Office Number])=[Forms]![frmMoveLocation]![NewLocation];")

DoCmd.SetWarnings (True)

DoCmd.Close

 

[fneily]

Can you use something like the following code that uses a recordset to update your table fields?

Private Sub Form_AfterUpdate()
Dim db As Database
Dim rs As Recordset
Dim strWhere As String
Set db = CurrentDb()
Set rs = db.OpenRecordset("YourTableName", dbOpenDynaset)
strWhere = "[FieldNameInTable] = " & Chr(34) & _
Me![FieldNameOnForm] & Chr(34)
rs.FindFirst strWhere
If rs.NoMatch Then
MsgBox "No match found"
Else
rs.Edit
rs![FieldNameInTable] = Me![FieldNameOnForm]
rs![OtherFieldNamesInTable] = Me![OtherFieldNamesOnForm]
etc.
rs.Update
End If
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub

 

[rbertram]

If I am following the code correctly, isn't this just a direct replacement for what I am already doing in the 2 SQL statements? I still need to move fields not listed on the form to the new cooresponding record. Is there something I am missing?

 

[fneily]

Maybe I'm not following. Do you have a table that has the fields: EmailID, Location, Phone, Analog Line? Then just have a form with a combobox to search the EmailID to find that record and change the Location.

 

[rbertram]

Actually your code helped a lot. I was able to expand on your idea to do what I needed. Here is the code:

Private Sub ProcessMove_Click()
On Error GoTo Err_ProcessMove_Click

    Dim db As Database
    Dim rs As Recordset
    Dim strEmailID As String
    Dim strLocation As String
    Dim intPhone As Long
    Dim cbAnalogLine As Integer
    
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("tblOffice", dbOpenDynaset)
    strEmailID = "[EmailID] = " & Chr(34) & _
        Me![EmailID] & Chr(34)
    strLocation = "[Office Number] = " & Chr(34) & _
        Me![NewLocation] & Chr(34)
        
    [green]' Find first record with requested ID[/green]
    rs.FindFirst strEmailID
    
    If rs.NoMatch Then
        MsgBox "No match found"
    Else
        [green]' Store current record's value for phone extension[/green]
        intPhone = rs![Phone]
        [green]' Store current record's value for analog line[/green]
        cbAnalogLine = rs![Analog Line]
        rs.Edit
        [green]' Reset all record values to original state, mark available & time stamp[/green]
        rs![EmailID] = Null
        rs![Phone] = Null
        rs![Analog Line] = 0
        rs![Available] = -1
        rs![lm_date] = Now()
        rs.Update
    End If
    
    [green]' Find first record with the new loction requested[/green]
    rs.FindFirst strLocation
    rs.Edit
    [green]' Copy values to the new location & time stamp.[/green]
    rs![EmailID] = Me![EmailID]
    rs![Phone] = intPhone
    rs![Analog Line] = cbAnalogLine
    rs![Available] = 0
    rs![lm_date] = Now()
    rs.Update
    
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
    
Exit_ProcessMove_Click:
    Exit Sub

Err_ProcessMove_Click:
    MsgBox Err.Description
    Resume Exit_ProcessMove_Click
End Sub

 

[fneily]

Excellent! You took a little example and ran with it. Pretty sharp. Nothing like having those intermediate variables to store data and then repostion them.