frmsupplier_new.frm

英文版Access数据库编程

      ForeColor       =   &H000000FF&
      Height          =   255
      Index           =   4
      Left            =   120
      TabIndex        =   25
      Top             =   1920
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "City:"
      ForeColor       =   &H000000FF&
      Height          =   255
      Index           =   3
      Left            =   120
      TabIndex        =   24
      Top             =   2280
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Address:"
      ForeColor       =   &H000000FF&
      Height          =   255
      Index           =   2
      Left            =   120
      TabIndex        =   23
      Top             =   1200
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Name:"
      ForeColor       =   &H000000FF&
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   22
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Credit Term:"
      ForeColor       =   &H000000FF&
      Height          =   255
      Index           =   12
      Left            =   120
      TabIndex        =   21
      Top             =   3360
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "Credit Limit:"
      ForeColor       =   &H000000FF&
      Height          =   255
      Index           =   11
      Left            =   120
      TabIndex        =   20
      Top             =   3000
      Width           =   1215
   End
End
Attribute VB_Name = "frmSupplier_New"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CheckSupplierFields()
If (Len(txtName.Text) = 0) Or (Len(txtAddress.Text) = 0) Or (Len(cmbCountry.Text) = 0) Or _
(Len(cmbState.Text) = 0) Or (Len(cmbCity.Text) = 0) Or (Len(txtPhone1(0).Text) = 0) Or (Len(txtPhone1(1).Text) = 0) Or _
(Len(txtFax1(0).Text) = 0) Or (Len(txtFax1(1).Text) = 0) Or (Len(txtLimit.Text) = 0) Or (Len(txtTerm.Text) = 0) Then
    cmdSave.Enabled = False
Else
    cmdSave.Enabled = True
End If
End Sub

Private Sub cmbCity_Change()
CheckSupplierFields
End Sub

Private Sub cmbCity_GotFocus()
If cmbCity.Text = "[PLEASE SELECT ONE]" Then
    cmbCity.Text = ""
End If
SelText cmbCity
End Sub

Private Sub cmbCity_LostFocus()
CapCon cmbCity
End Sub

Private Sub cmbCountry_Change()
CheckSupplierFields
End Sub

Private Sub cmbCountry_Click()
FillComboState cmbState, cmbCountry.Text
End Sub

Private Sub cmbCountry_GotFocus()
If cmbCountry.Text = "[PLEASE SELECT ONE]" Then
    cmbCountry.Text = ""
End If
SelText cmbCountry
End Sub

Private Sub cmbCountry_LostFocus()
CapCon cmbCountry
End Sub

Private Sub cmbState_Change()
CheckSupplierFields
End Sub

Private Sub cmbState_Click()
FillComboCity cmbCity, cmbState.Text
End Sub

Private Sub cmbState_GotFocus()
If cmbState.Text = "[PLEASE SELECT ONE]" Then
    cmbState.Text = ""
End If
SelText cmbState
End Sub

Private Sub cmbState_LostFocus()
CapCon cmbState
End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdSave_Click()
If CCur(txtLimit.Text) <= 0 Then
    ValidMsg "Credit limit has to been more than $0.", "Invalid value"
    txtLimit.SetFocus
Else
    Dim saveSQL As String, tempChar As String
    Dim newID As Long
    'Get unique ID
    tempChar = Left$(txtName.Text, 1)
    If IsNumeric(tempChar) = True Then
        tempChar = "#"
    End If
    'define query
    saveSQL = "SELECT Ref_Number FROM Supplier_IDs WHERE InitialID='" & tempChar & "';"
    On Error GoTo ErrHandler
    'execute query
    Dim saveRS As Recordset, tempRS As Recordset
    RSOpen tempRS, saveSQL, dbOpenDynaset
    newID = tempRS("Ref_Number") 'Obtained the reference number needed to form unique ID
    
    On Error GoTo ErrHandler
    saveSQL = "SELECT * FROM Suppliers;"
    RSOpen saveRS, saveSQL, dbOpenDynaset
    saveRS.AddNew
    saveRS("SupplierID") = tempChar & Format$(newID, "0000")
    saveRS("Name") = txtName.Text
    saveRS("Address") = txtAddress.Text
    saveRS("City") = cmbCity.Text
    saveRS("State") = cmbState.Text
    saveRS("Country") = cmbCountry.Text
    saveRS("Zip") = txtZip.Text
    saveRS("ACPhone1") = txtPhone1(0).Text
    saveRS("ACPhone2") = txtPhone2(0).Text
    saveRS("ACFax1") = txtFax1(0).Text
    saveRS("ACFax2") = txtFax2(0).Text
    saveRS("Fax1") = txtFax1(1).Text
    saveRS("Fax2") = txtFax2(1).Text
    saveRS("Phone1") = txtPhone1(1).Text
    saveRS("Phone2") = txtPhone2(1).Text
    saveRS("Email") = txtEmail.Text
    saveRS("CreditTerm") = txtTerm.Text
    saveRS("CreditLimit") = txtLimit.Text
    saveRS.Update
    
    tempRS.Edit
    tempRS("Ref_Number") = newID + 1
    tempRS.Update
    'Close the recordsets and free memory
    tempRS.Close
    saveRS.Close
    Set tempRS = Nothing
    Set saveRS = Nothing
    'Insert into systems log
    insertLog "Supplier ID: " & tempChar & Format$(newID, "0000") & " account has been created."


    InfoMsg "Supplier ID: " & tempChar & Format$(newID, "0000") & vbCrLf & "New supplier record has been successfully created.", "Record save"
    Unload Me
End If

ErrHandler:
If Err.Number <> 0 Then
    ErrorNotifier Err.Number, Err.description
End If
End Sub

Private Sub Form_Load()
isOpen = False
FillComboCountry cmbCountry
lblHeader.Caption = "Red labels indicate required fields. Please enter the details of the new supplier accurately." & vbNewLine & _
"Entries will be converted to upper-case automatically."
DisableClose Me, True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set frmCustomer_New = Nothing
End Sub

Private Sub txtAddress_Change()
CheckSupplierFields
End Sub

Private Sub txtAddress_GotFocus()
SelText txtAddress
End Sub

Private Sub txtAddress_LostFocus()
CapCon txtAddress
End Sub

Private Sub txtEmail_Change()
CheckSupplierFields
End Sub

Private Sub txtEmail_GotFocus()
SelText txtEmail
End Sub

Private Sub txtFax1_Change(Index As Integer)
CheckSupplierFields
End Sub

Private Sub txtFax1_GotFocus(Index As Integer)
SelText txtFax1(Index)
End Sub

Private Sub txtFax1_KeyPress(Index As Integer, KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtFax1_LostFocus(Index As Integer)
If Index = 0 Then
    If txtFax1(Index).Text <> "" Then
        txtFax1(Index).Text = Format$(txtFax1(Index).Text, "000")
    End If
End If

End Sub

Private Sub txtFax2_Change(Index As Integer)
CheckSupplierFields
End Sub

Private Sub txtFax2_GotFocus(Index As Integer)
SelText txtFax2(Index)
End Sub

Private Sub txtFax2_KeyPress(Index As Integer, KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtFax2_LostFocus(Index As Integer)
If Index = 0 Then
    If txtFax2(Index).Text <> "" Then
        txtFax2(Index).Text = Format$(txtFax2(Index).Text, "000")
    End If
End If
End Sub

Private Sub txtLimit_Change()
CheckSupplierFields
End Sub

Private Sub txtLimit_GotFocus()
SelText txtLimit
End Sub

Private Sub txtLimit_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtName_Change()
CheckSupplierFields
End Sub

Private Sub txtName_GotFocus()
SelText txtName
End Sub

Private Sub txtName_LostFocus()
CapCon txtName
End Sub

Private Sub txtPhone1_Change(Index As Integer)
CheckSupplierFields
End Sub

Private Sub txtPhone1_GotFocus(Index As Integer)
SelText txtPhone1(Index)
End Sub

Private Sub txtPhone1_KeyPress(Index As Integer, KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtPhone1_LostFocus(Index As Integer)
If Index = 0 Then
    If txtPhone1(Index).Text <> "" Then
        txtPhone1(Index).Text = Format$(txtPhone1(Index).Text, "000")
    End If
End If
End Sub

Private Sub txtPhone2_Change(Index As Integer)
CheckSupplierFields
End Sub

Private Sub txtPhone2_GotFocus(Index As Integer)
SelText txtPhone2(Index)
End Sub

Private Sub txtPhone2_KeyPress(Index As Integer, KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtPhone2_LostFocus(Index As Integer)
If Index = 0 Then
    If txtPhone2(Index).Text <> "" Then
        txtPhone2(Index).Text = Format$(txtPhone2(Index).Text, "000")
    End If
End If

End Sub

Private Sub txtTerm_Change()
CheckSupplierFields
End Sub

Private Sub txtTerm_GotFocus()
SelText txtTerm
End Sub

Private Sub txtTerm_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Private Sub txtZip_Change()
CheckSupplierFields
End Sub

Private Sub txtZip_GotFocus()
SelText txtZip
End Sub

Private Sub txtZip_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub udTerm_Change()
CheckSupplierFields
End Sub