'DoCmd.ShowAllRecords
'DoCmd.FindRecord
![](/Images/OutliningIndicators/None.gif)
'Add a filter function when the list(fltSalesGroup) changed.
Private Sub fltSalesGroup_Change()
Dim strFilterSQL As String
Const strSQL = "SELECT * FROM FORECAST_12M WHERE STATUS=0 AND FC_PERIOD='200710' "
strFilterSQL = strSQL + " AND [SalesGroup] = '" + Me!fltSalesGroup + "'"
Me.RecordSource = strFilterSQL
Me.Requery
End Sub
![](/Images/OutliningIndicators/None.gif)
'Confirm the update action before update
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim intSelect As Integer
intSelect = MsgBox("Do you want to update this line data?", vbYesNo + vbQuestion, "Notice")
If intSelect <> vbYes Then
Me.Form.Undo
Else
Call logCustomer(Me!txtCustomerCode)
End If
End Sub
![](/Images/OutliningIndicators/None.gif)
'--------------------------------
'Modules
'log the actions
Public Function logCustomer(ByVal strCustomerCode As String)
On Error GoTo Err
Dim conn As ADODB.Connection
Dim strSQL As String
Set conn = CurrentProject.Connection
strSQL = "INSERT INTO history_Customer SELECT CustomerCode, ShortName, Region, BillTo, '" & osMachineName() & "' AS InputUser, Now() AS InputTime FROM Forecast_Customer WHERE CustomerCode='" & strCustomerCode & "'"
conn.Execute (strSQL)
Set conn = Nothing
Exit Function
![](/Images/OutliningIndicators/None.gif)
Err:
MsgBox Err.Number & Err.Description
End Function
![](/Images/OutliningIndicators/None.gif)
'To get the client machine name through Windows API
Private Declare Function getComputerName_API Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
![](/Images/OutliningIndicators/None.gif)
Function osMachineName() As String
Dim lngLen As Long, lngX As Long
Dim strCompName As String
![](/Images/OutliningIndicators/None.gif)
lngLen = 16
strCompName = String$(lngLen, 0)
lngX = getComputerName_API(strCompName, lngLen)
If lngX <> 0 Then
osMachineName = Left$(strCompName, lngLen)
Else
osMachineName = ""
End If
End Function
|