Good idea.
A Form is not SQL, and SQL is not a recordset.
You're basing the form on something - I presume a query. What query?
So you want to see which records will be updated - fine. You could also
display the old and new prices on the form if you wish... right?
Please post the rest of the code - in particular the code which defines rs and
rsListHist.
Again to clarify: you want to do two things - append the records prior tothe
change into a history table, and then update those records to the new price?
Did you *intentionally and purposefully* choose to use the (relatively
inefficient) recordset crawling rather than an Append query followed by an
Update query?
John ... Here is the entire code after the CLICK on the switchboard.
Believe me there are many other flaws that need cleanup but am leaving
it as is for you to critique which I truly appreciate.
T answer your specific question "Did you intentionally and ....." Yes!
Based on a post within the group on the same history file topic which
seemed to make sense to me and was not shot down in flames as an
inefficient way to go. Thanks again John.
Private Sub Form_Open(Cancel As Integer)
On Error GoTo ErrorTrap
'****************************************************************
Dim db As DAO.Database
Dim rs As DAO.Recordset
'****************************************************************
Dim intResponse As Integer
Dim intDiscount As Single 'New discount input thru
InputBox
Dim intMessage, Title As String 'Message for new discount
InputBox
Dim strInput As String 'Contains the new discount
Dim strSQL As String 'String containing SQL for
recordset
Dim strItem As String 'Contains the new SQL input
SIS code String
Dim strMessage, strTitle As String 'Pertains to the InputBox
requesting the SIS code String for the SQL
Dim response As String
'**************************************************************
Set db = CurrentDb()
strMessage = "Please input the SIS code filter string"
strTitle = "PURCHASE DISCOUNT UPDATE."
response = InputBox(strMessage, strTitle, Default, 5000, 3000)
If Trim(response) = "" Or IsNull(response) Then ' Check for empty
return
DoCmd.Close acForm, "frmDiscountUpdate", acSaveNo
Exit Sub
Else
strItem = response
End If
strSQL = "SELECT tblMaterialMaster.SISitemCode,"
strSQL = strSQL & "tblMaterialMaster.MaterialDescription,"
strSQL = strSQL & "tblMaterialMaster.Discount"
strSQL = strSQL & " FROM tblMaterialMaster"
strSQL = strSQL & " WHERE ((tblMaterialMaster.SISItemCode) Like "
& """" & strItem & """)"
strSQL = strSQL & " ORDER BY tblMaterialMaster.SISitemCode"
'Set rs = db.OpenRecordset(strSQL)
Me.RecordSource = strSQL
'******************************************************************
NormalExit:
Exit Sub ' or Exit Function
ErrorTrap:
If Err = 2501 Then
Resume Next
Else
MsgBox Err.Description, , Str(Err)
Resume NormalExit
End If
End Sub
***** The following is the code behind the button on the form *******
Private Sub cmdListUpdate_Click()
On Error GoTo ErrorTrap
'****************************************************************
Dim rsListHist As DAO.Recordset
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim intResponse As Integer
Dim intDiscount As Single 'New discount input thru
InputBox
Dim intMessage As String 'Message for new discount
InputBox
Dim Title As String
Dim strInput As String 'Contains the new discount
Dim strSQL As String 'String containing SQL for
recordset
Dim strItem As String 'Contains the new SQL input
SIS code String
Dim strMessage As String 'Pertains to the InputBox requesting
the SIS code String for the SQL
Dim strTitle As String
Dim response As String
Dim strCtl As String
Dim ctlSource As String
Dim intCount As Integer
Dim intRecCount As Integer
'**************************************************************
Set db = CurrentDb()
strMessage = "Please input the SIS code filter string"
strTitle = "PURCHASE DISCOUNT UPDATE."
response = InputBox(strMessage, strTitle, Default, 5000, 3000)
If Trim(response) = "" Or IsNull(response) Then ' Check for empty
return
DoCmd.Close acForm, "frmDiscountUpdate", acSaveNo
Exit Sub
Else
strItem = response
End If
strSQL = "SELECT tblMaterialMaster.Funds,"
strSQL = strSQL & "tblMaterialMaster.SISItemCode,"
strSQL = strSQL & "tblMaterialMaster.CostPerInvUnit,"
strSQL = strSQL & "tblMaterialMaster.Supplier,"
strSQL = strSQL & "tblMaterialMaster.Contents,"
strSQL = strSQL & "tblMaterialMaster.ManufacturerName,"
strSQL = strSQL & "tblMaterialMaster.LocalGroup,"
strSQL = strSQL & "tblMaterialMaster.LocalSubGroup,"
strSQL = strSQL & "tblMaterialMaster.ManufacturerNo,"
strSQL = strSQL & "tblMaterialMaster.MaterialDescription,"
strSQL = strSQL & "tblMaterialMaster.MaterialNote,"
strSQL = strSQL & "tblMaterialMaster.CorpMatlGrp,"
strSQL = strSQL & "tblMaterialMaster.InvUnit,"
strSQL = strSQL & "tblMaterialMaster.ListPrice,"
strSQL = strSQL & "tblMaterialMaster.Discount,"
strSQL = strSQL & "tblMaterialMaster.CostDateNote"
strSQL = strSQL & " FROM tblMaterialMaster"
strSQL = strSQL & " WHERE ((tblMaterialMaster.SISItemCode) Like "
& """" & strItem & """)"
strSQL = strSQL & " ORDER BY tblMaterialMaster.SISitemCode"
Set rs = db.OpenRecordset(strSQL)
Debug.Print " RecordCount = " & _
rs.RecordCount
With rs
.MoveLast
.MoveFirst
End With
'Me.RecordSource = strSQL
Set rsListHist = db.OpenRecordset("tblMaterialMasterHistory")
'Me.RecordSource = "tblMaterialMasterHistory"
Debug.Print " RecordCount = " & _
rs.RecordCount
intRecCount = rs.RecordCount
Debug.Print intRecCount
Destination:
intMessage = "Please input the new discount as a decimal"
Title = "Discount Update"
strInput = InputBox(intMessage, Title, Default, 5000,
3000)
intDiscount = Val(strInput)
Debug.Print intDiscount
If intDiscount >= 1 Then
intResponse = MsgBox("Please input as a decimal as
asked!", vbOKOnly + vbCritical, "WHOOOPS!")
GoTo Destination
Else
' Write changes to the history file
strCtl = Me!Discount.Name
ctlSource = Me.Discount.ControlSource
With rsListHist
'For intCount = 1 To rs.RecordCount
intCount <= rs.RecordCount
'.MoveFirst
Do Until / while ????
'Debug.Print intCount
Debug.Print Me.SISItemCode
rsListHist.AddNew
rsListHist!FieldName = strCtl
rsListHist!UserName = CurrentUser()
rsListHist!SISItemCode = SISItemCode
rsListHist!ChngeDate = Now()
rsListHist!OldDiscount = Discount.OldValue
rsListHist!NewDiscount = intDiscount
rsListHist!ControlSource = ctlSource
rsListHist.Update
.MoveNext
Loop
End With
'Next
****** The following code seems to do what I
expect ******
' Change all discount values
With rs
.MoveFirst
Do While Not .EOF
.Edit
rs!Discount = intDiscount
If intDiscount = 0 Then
Exit Sub
End If
.Update
.MoveNext
Loop
End With
End If
rs.Close
rsListHist.Close
db.Close
Set rs = Nothing
Set rsListHist = Nothing
Set db = Nothing
NormalExit:
Exit Sub ' or Exit Function
ErrorTrap:
If Err = 2501 Then
Resume Next
Else
MsgBox Err.Description, , Str(Err)
Resume NormalExit
End If
End Sub
