frmservercheck.frm

客户关系管理系统(打包+源程序)是数据库系统开发项目方案精解系列丛书VB数据库管理中附带CD中的程序

      Width           =   1215
   End
   Begin VB.Label Label4 
      Alignment       =   1  'Right Justify
      Caption         =   "问题（现状）描述"
      Height          =   255
      Left            =   240
      TabIndex        =   11
      Top             =   2760
      Width           =   1575
   End
   Begin VB.Label Label5 
      Alignment       =   1  'Right Justify
      Caption         =   "解决方案描述"
      Height          =   255
      Left            =   240
      TabIndex        =   10
      Top             =   4560
      Width           =   1215
   End
End
Attribute VB_Name = "frmServerCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
    Dim WithEvents rsNames As ADODB.Recordset
Attribute rsNames.VB_VarHelpID = -1

Private Sub rsNames_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    Dim inti As Integer     '用于for循环，记录当前是第几条记录
    Dim Rstclone As New ADODB.Recordset
    
    If pRecordset.BOF = True Or pRecordset.EOF = True Then  '当前记录超出，不再执行此事件
        Exit Sub
    End If
    Set Rstclone = pRecordset.Clone(adLockReadOnly) '复制当前使用的记录集
    If adReason = adRsnMoveFirst Or adRsnMoveLast Or adRsnMoveNext Or adRsnMovePrevious Then
        Rstclone.MoveFirst
        For inti = 1 To Rstclone.RecordCount        '查找当前记录在副本记录集中的位置
            If Rstclone!QuestID = pRecordset!QuestID Then
                Me.Adodc1.Caption = "当前位于第 " & inti & " 条记录"
                Exit For
            End If
            Rstclone.MoveNext
        Next
        If Left(pRecordset.Fields("Questperson").Value, 1) = "S" Then   '问题提交者是供应商
            Me.Text1.Text = Mid(pRecordset!questperson, 2, Len(pRecordset!questperson) - 1)
            Me.Text2 = ""
        End If
        If Left(pRecordset.Fields("Questperson").Value, 1) = "C" Then   '问题提交者是客户
            Me.Text1 = ""
            Me.Text2.Text = Mid(pRecordset!questperson, 2, Len(pRecordset!questperson) - 1)
        End If
    End If

End Sub

Private Sub Check1_Click()
    If Me.Check1.Value = vbChecked Then
        Me.DT_QuestDate.Enabled = True
    Else
        Me.DT_QuestDate.Enabled = False
    End If
End Sub

Private Sub cmdCheck_Click()
    Dim Rst As New ADODB.Recordset  '用于打开一个临时记录集
    Dim strCheck As String
    Dim strSQL As String           '用于记录集的查询语句
    
On Error GoTo ErrorExit
    strCheck = ""
    If Me.txtQuestID <> "" Then     '问题信息单号的查询条件
        strCheck = " QuestID = " & Me.txtQuestID.Text
    End If
    If Me.Check1.Value = vbChecked Then  '问题提交时间的查询条件
        If strCheck <> "" Then
            strCheck = strCheck & " AND "
        End If
        strCheck = strCheck & " QuestDate = #" & Me.DT_QuestDate.Value & "#"
    End If
    If Me.txtViaperson.Text <> "" Then    '经办人的查询条件
        If strCheck <> "" Then
            strCheck = strCheck & " AND "
        End If
        strCheck = strCheck & " Viaperson ='" & Me.txtViaperson.Text & "'"
    End If
    If Me.Option1.Value = True Then       '问题提交者：供应商
        If Me.Text1 <> "" Then
            If strCheck <> "" Then
                strCheck = strCheck & " AND "
            End If
            strCheck = strCheck & " Questperson = 'S" & Me.Text1.Text & "'"
        End If
    End If
    If Me.Option2.Value = True Then       '问题提交者：客户
        If Me.Text2 <> "" Then
            If strCheck <> "" Then
                strCheck = strCheck & " AND "
            End If
            strCheck = strCheck & " Questperson = 'C" & Me.Text2.Text & "'"
        End If
    End If
    strSQL = "select * from tb_Quest "
    If strCheck <> "" Then                '查询的SQL语句
        strSQL = strSQL & " WHERE " & strCheck
    End If
    Rst.Open strSQL, CnnDatabase, adOpenStatic, adLockReadOnly '打开的记录集为空
    MsgBox "查找到" & Rst.RecordCount & "条记录！"
    If Rst.RecordCount <> 0 Then        '如果找到了记录（记录数 > 0）
        Me.Adodc1.Enabled = True        '准备使用Adodc控件
        Set rsNames = New ADODB.Recordset
        Set rsNames = Rst
        Set Me.Adodc1.Recordset = rsNames   'Adodc与当前查到的临时记录集关联
        AdodcEnable                     '让界面上所有控件内容与Adodc关联
    End If
    Exit Sub
    
ErrorExit:
    MsgBox Err.Description, vbCritical, Me.Caption
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub Initial_Add()
    Me.txtQuestID = ""      '清空界面
    Me.txtViaperson = ""
    Me.txtDescription = ""
    Me.txtSolution = ""
    Me.Check1.Value = vbUnchecked
    Me.DT_QuestDate.Value = Date    '初始今天日期
    Me.DT_QuestDate.Enabled = False
    Me.Option1.Value = True         '供应商的单选可用
    Me.Option2.Value = False
    Me.Text1.Enabled = True         '供应商代码栏可用
    Me.Text2.Enabled = False
    Me.Text1.BackColor = &H80000005 '供应商代码栏背景为白色
    Me.Text2.BackColor = &H80000013 '客户代码栏为灰色
    Me.Text1 = ""
    Me.Text2 = ""
    Me.Adodc1.Enabled = False
    AdodcEnable                     '判断Adodc是否可用和建立关联
End Sub

Private Sub cmdClear_Click()
    Initial_Add
End Sub

Private Sub Form_Load()
    Initial_Add
End Sub

Private Sub Option1_Click()
    Me.Text1.Enabled = True         '供应商代码栏可用
    Me.Text2.Enabled = False
    Me.Text1.BackColor = &H80000005 '供应商代码栏背景为白色
    Me.Text2.BackColor = &H80000013 '客户代码栏为灰色
    Me.Text1 = ""
    Me.Text2 = ""

End Sub

Private Sub Option2_Click()
    Me.Text1.Enabled = False        '供应商代码栏不可用
    Me.Text2.Enabled = True         '客户代码栏可用
    Me.Text1.BackColor = &H80000013 '供应商代码栏背景为灰色
    Me.Text2.BackColor = &H80000005 '客户代码栏背景为白色
    Me.Text1 = ""
    Me.Text2 = ""

End Sub

Private Sub AdodcEnable()           '将界面上的所有控件内容与Adodc控件关联
    If Me.Adodc1.Enabled = True Then
        Set Me.txtQuestID.DataSource = Me.Adodc1    '将问题信息单号与Adodc控件绑定
        Me.txtQuestID.DataField = "QuestID"
        Set Me.DT_QuestDate.DataSource = Me.Adodc1  '将问题提交日期与Adodc控件绑定
        Me.DT_QuestDate.DataField = "QuestDate"
        Set Me.txtViaperson.DataSource = Me.Adodc1  '将经办人栏与Adodc控件绑定
        Me.txtViaperson.DataField = "Viaperson"
        Set Me.txtDescription.DataSource = Me.Adodc1 '将问题描述与Adodc控件绑定
        Me.txtDescription.DataField = "Description"
        Set Me.txtSolution.DataSource = Me.Adodc1   '将解决方案栏与Adodc控件绑定
        Me.txtSolution.DataField = "Solution"
        Me.txtQuestID.Enabled = False               '所有界面上的空件不可用（放置以外修改）
        Me.Check1.Enabled = False
        Me.txtViaperson.Enabled = False
        Me.Option1.Enabled = False
        Me.Option2.Enabled = False
        Me.Text1.Enabled = False
        Me.Text2.Enabled = False
    Else
        Set Me.txtQuestID.DataSource = Nothing      '解除绑定
        Me.txtQuestID.DataField = ""
        Set Me.DT_QuestDate.DataSource = Nothing
        Me.DT_QuestDate.DataField = ""
        Set Me.txtViaperson.DataSource = Nothing
        Me.txtViaperson.DataField = ""
        Set Me.txtDescription.DataSource = Nothing
        Me.txtDescription.DataField = ""
        Set Me.txtSolution.DataSource = Nothing
        Me.txtSolution.DataField = ""
        Me.txtQuestID.Enabled = True                '使界面上的控件可用
        Me.Check1.Enabled = True
        Me.txtViaperson.Enabled = True
        Me.Option1.Enabled = True
        Me.Option2.Enabled = True
    End If
End Sub