frmmain.frm

监控类的开发

        ![Delay] = strDelay
        ![Remark] = strRemark
        .Update
        .Requery
    End With
    
END_MARK:
    If txtPhone.Locked = True Then mStart_CallIn_Click
    cmdOK.Enabled = False
End Sub

Private Sub cmdSend_Click()
    Dim I As Integer
    On Error Resume Next 'CallerID
    
    strSM_Start = Format(Time, "hh:mm:ss")
    
    If DG_Nows.Visible = False Then
        MsgBox Chr(&H22) + "当前订单" + Chr(&H22) + "下才能发送短信！", vbExclamation + vbOKOnly + "提示"
        GoTo END_MARK
    End If
    
    
    strMailTo = GetMailName(FromAreaID_Mb(nSM_Area))
    If strMailTo = "" Then
        MsgBox "外勤员工的手机号码有误！", vbCritical + vbOKOnly, "提示"
        GoTo END_MARK
    End If
    
    If strMailFrom = "" Then
        MsgBox "公司信息中的手机号码有误！", vbCritical + vbOKOnly, "提示"
        GoTo END_MARK
    End If
    
    strOut_SM = ""
    With AdodcCaller.Recordset
        .MoveFirst
        Do While Not .EOF
            If ![Area] = nSM_Area Then
                I = I + 1
                strOut_SM = strOut_SM + Trim(Str(I)) + "→" + _
                                        ![Phone] + "/" + ![Address] + "/" + _
                                        Trim(Str(![Quantity])) + "/" + _
                                        Trim(Str(![Sort])) + "/" + _
                                        IIf(IsNull(![Delay]), "-", ![Delay]) + "/" + _
                                        IIf(IsNull(![Remark]), "-", ![Remark]) + "/| "
            End If
            .MoveNext
        Loop
        
        If strOut_SM = "" Then
            MsgBox "请重新选择合适的记录!", vbExclamation + vbOKOnly, "提示"
            Exit Sub
        End If
        
        strOut_SM = strOut_SM + "结束"
    End With
    
    mSendSM_Click
    
END_MARK:
    cmdSend.Enabled = False
    txtArea.ForeColor = vbBlack
End Sub

Private Sub DG_Clients_Click()
    On Error Resume Next 'CallerID
    On Error GoTo END_MARK
    
    With AdodcCaller.Recordset
        If .EOF Or .BOF Or .RecordCount < 1 Then Exit Sub
        txtAddress.Text = ![Address]
        txtArea.Text = ![Area]
        txtSort.Text = ![Sort]
        If Not IsNull(![Name]) Then txtName = ![Name]
        strAddress = ![Address]
    End With
END_MARK:
End Sub

Private Sub DG_Nows_Click()
    On Error Resume Next 'CallerID
    
    If DG_Nows.Caption <> "当前订单" Then Exit Sub
    
    With AdodcCaller.Recordset
        If .EOF Or .BOF Or .RecordCount < 1 Then Exit Sub
        
        If Not IsNull(![Area]) Then
            nSM_Area = ![Area]
            txtArea.Text = nSM_Area
            cmdSend.Enabled = True
            txtArea.ForeColor = vbRed
        Else
            nSM_Area = 0
            cmdSend.Enabled = False
            txtArea.ForeColor = vbBlack
        End If
    End With
End Sub

Private Sub mAbout_Click()
    frmAbout.Show vbModal
End Sub

Private Sub mArea_Click()
    frmArea.Show
End Sub

Private Sub mClientRecord_Click()
    frmClientsRecord.Show
End Sub

Private Sub mClients_Click()
    Display_Clients
End Sub

Private Sub mClose_CallIn_Click()
    If MSComm1.PortOpen = True Then MSComm1.PortOpen = False
End Sub

Private Sub mCompany_Click()
    frmCompany.Show vbModal
End Sub

Private Sub mDays_Click()
    Display_Days
End Sub

Private Sub mHis_Order_Click()
    frmHistory.Show
End Sub

Private Sub mHistory_Click()
    Display_History
End Sub

Private Sub mLetZero_Click()
    Dim strTmp As String
    Dim nRet As Integer
    On Error Resume Next 'CallerID
    
    strTmp = Format(Date, "yyyy-mm-dd")
    If strTmp <> GetMonthEnd(strTmp) Then
        MsgBox "今天不是月底，不能清零！", vbExclamation + vbOKOnly, "提示"
        Exit Sub
    End If
    
    nRet = MsgBox("确信对所有客户的累计清零吗？", vbQuestion + vbYesNo, "提示")
    If nRet = 7 Then Exit Sub
    
    Display_Clients
    With AdodcCaller.Recordset
        If .RecordCount < 1 Then Exit Sub
        .MoveFirst
        Do While Not .EOF
            ![Total] = 0
            .Update
            .MoveNext
        Loop
        .Requery
        MsgBox "所有客户的累计均被清零!", vbInformation + vbOKOnly, "任务完成"
    End With
End Sub

Private Sub mLogs_Click()
    frmLogs.Show vbModal
End Sub

Private Sub mManual_Input_Click()
    txtPhone.Locked = False
    txtRemark.Enabled = False
    mClose_CallIn_Click
    MsgBox "手工录入开启！", vbInformation + vbOKOnly, "提示"
    txtPhone.SetFocus
End Sub

Private Sub mMonthOperator_Click()
    Dim strMonth As String
    Dim strPrnNames As String
    Dim strTmp As String
    Dim l1 As Long
    Dim l2 As Long
    Dim l3 As Long
    Dim l4 As Long
    Dim strData As String
    Dim nCount As Integer
    On Error Resume Next 'CallerID
    
    strMonth = InputBox("数据输入格式为 " + Chr(&H22) + "年-月" + Chr(&H22) + _
                        " ( 如 2005-5 ) : ", "请输入月度操作的年月", _
                         GetNoString(Format(Date, "yyyy-mm-dd"), "-", 0) + "-")
                         
    strTmp = NextString(strMonth, "-")
    If Len(strMonth) < 6 Or Val(strTmp) < 1 Or GetNoString(strMonth, "-", 0) < "2000" Then
        MsgBox "数据输入有误！", vbCritical + vbOKOnly, "请注意数据格式"
        Exit Sub
    End If
    If Len(strTmp) = 1 Then strMonth = GetNoString(strMonth, "-", 0) + "-0" + strTmp
    
    With frmOperator.AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataPath + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select * from Logs where [Date]>='" + _
                         strMonth + "-01' and [Date]<='" + _
                         strMonth + "-31' order by [Date], [Login]"
        .Refresh
        With .Recordset
            If .RecordCount < 1 Then
                MsgBox GetNoString(strMonth, "-", 0) + "年" + _
                       NextString(strMonth, "-") + "月没有数据", _
                       vbExclamation + vbOKOnly, "提示"
                Exit Sub
            Else
                .MoveFirst
                Do While Not .EOF
                    
                    strTmp = IIf(IsNull(![Date]), "", Trim(Str(Val(GetNoString(![Date] + "-", "-", 2)))))
                    strData = strData + strTmp + "," + Trim(Str(![ID])) + "," + _
                              IIf(IsNull(![Login]), "", ![Login]) + "," + _
                              IIf(IsNull(![Logout]), "", ![Logout]) + "," + _
                              IIf(![Callers] = 0, "", Trim(Str(![Callers]))) + "," + _
                              IIf(![Orders] = 0, "", Trim(Str(![Orders]))) + "," + _
                              IIf(![SMs] = 0, "", Trim(Str(![SMs]))) + "," + _
                              IIf(![Bottles] = 0, "", Trim(Str(![Bottles]))) + ",," + _
                              Trim(Str(nOperatorID)) + "," + Trim(Str(Val(GetNoString(![Date], "-", 1)))) + ","

                    l1 = l1 + ![Callers]
                    l2 = l2 + ![Orders]
                    l3 = l3 + ![SMs]
                    l4 = l4 + ![Bottles]
                    
                    nCount = nCount + 1
                    If nCount = .RecordCount Then
                        strData = strData + Trim(Str(l1)) + "," + Trim(Str(l2)) + "," + _
                                            Trim(Str(l3)) + "," + Trim(Str(l4))
                    End If
                    
                    .MoveNext
                    If Not .EOF Then strData = strData + vbCrLf
                Loop
            End If
        End With
    End With
    
    WriteStringToTxt strData, App.Path + "\Operators.txt"
    strPrnNames = "日期;工号;登录时间;退出时间;来电数;订单数;短信数;瓶数;备注;操作员;月份;电总;单总;信总;瓶总;"
    
    DataPrint App.Path + "\Operators.txt", App.Path + "\Operator", strPrnNames, 2
End Sub

Private Sub mMonthOrder_Click()
    Dim strMonth As String
    Dim strPrnNames As String
    Dim strTmp As String
    Dim l1 As Long
    Dim strData As String
    Dim nCount As Integer
    Dim strSet As String
    On Error Resume Next 'CallerID
    
    strMonth = InputBox("数据输入格式为 " + Chr(&H22) + "年-月" + Chr(&H22) + _
                        " ( 如 2005-5 ) : ", "请输入月度订单的年月", _
                         GetNoString(Format(Date, "yyyy-mm-dd"), "-", 0) + "-")
    
    strTmp = NextString(strMonth, "-")
    If Len(strMonth) < 6 Or Val(strTmp) < 1 Or GetNoString(strMonth, "-", 0) < "2000" Then
        MsgBox "数据输入有误！", vbCritical + vbOKOnly, "请注意数据格式"
        Exit Sub
    End If
    If Len(strTmp) = 1 Then strMonth = GetNoString(strMonth, "-", 0) + "-0" + strTmp
    
    Display_History
    
    With AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataHistory + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select [Sort],sum([Quantity]) as [Quantity] from DayCounts where [Date]>='" + _
                         strMonth + "-01' and [Date]<='" + _
                         strMonth + "-31' group by [Sort] order by [Sort]"
        .Refresh
        If .Recordset.RecordCount < 1 Then
            MsgBox GetNoString(strMonth, "-", 0) + "年" + _
                   NextString(strMonth, "-") + "月没有数据", _
                   vbExclamation + vbOKOnly, "提示"
            Exit Sub
        End If
        
        .Recordset.MoveFirst
        strSet = "品种/小计："
        Do While Not .Recordset.EOF
            strSet = strSet + ts(.Recordset![Sort]) + "/" + ts(.Recordset![Quantity]) + "； "
            .Recordset.MoveNext
        Loop
    
        .RecordSource = "select * from DayCounts where [Date]>='" + _
                         strMonth + "-01' and [Date]<='" + _
                         strMonth + "-31' order by [ID]"
        .Refresh
        With .Recordset
            .MoveFirst
            Do While Not .EOF
                nCount = nCount + 1
                    
                strData = strData + ts(nCount) + "," + ![Phone] + "," + _
                          ![Address] + "," + ts(Val(GetNoString(![Date] + "-", "-", 2))) + "," + _
                          GetNoString(![Time], ":", 0) + ":" + GetNoString(![Time], ":", 1) + "," + _
                          ts(![Quantity]) + "," + ts(![Sort]) + "," + ts(![Area]) + "," + _
                          IIf(IsNull(![Remark]), "", ![Remark]) + "," + _
                          ts(Val(GetNoString(strMonth + "-", "-", 1))) + ","

                l1 = l1 + ![Quantity]
                    
                If nCount = .RecordCount Then
                    strData = strData + ts(nOperatorID) + "," + strSet + "总计：" + ts(l1) + "瓶"
                End If
                    
                .MoveNext
                If Not .EOF Then strData = strData + vbCrLf
            Loop
        End With
    End With
    
    WriteStringToTxt strData, App.Path + "\DayCounts.txt"
    strPrnNames = "序号;电话;地址;日期;时间;数量;品种;区域;备注;月份;操作员;瓶总;"
    
    DataPrint App.Path + "\DayCounts.txt", App.Path + "\DayCounts", strPrnNames, 2
End Sub

Private Sub mMonthOuter_Click()
    Dim strMonth As String
    Dim strPrnNames As String
    Dim strTmp As String
    Dim l1 As Long
    Dim strData As String
    Dim nCount As Integer
    Dim nTmp As Integer
    On Error Resume Next 'CallerID
    
    strMonth = InputBox("数据输入格式为 " + Chr(&H22) + "年-月" + Chr(&H22) + _
                        " ( 如 2005-5 ) : ", "请输入月度外勤的年月", _
                         GetNoString(Format(Date, "yyyy-mm-dd"), "-", 0) + "-")
                         
    strTmp = NextString(strMonth, "-")
    If Len(strMonth) < 6 Or Val(strTmp) < 1 Or GetNoString(strMonth, "-", 0) < "2000" Then
        MsgBox "数据输入有误！", vbCritical + vbOKOnly, "请注意数据格式"
        Exit Sub
    End If
    If Len(strTmp) = 1 Then strMonth = GetNoString(strMonth, "-", 0) + "-0" + strTmp
    
    
    Display_History
    With AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataHistory + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select [Area],sum([Quantity]) as [Quantity] from DayCounts where [Date]>='" + _
                         strMonth + "-01' and [Date]<='" + _
                         strMonth + "-31' group by [Area] order by [Area]"
        .Refresh
        With .Recordset
            If .RecordCount < 1 Then
                MsgBox GetNoString(strMonth, "-", 0) + "年" + _
                       NextString(strMonth, "-") + "月没有数据", _
                       vbExclamation + vbOKOnly, "提示"
                Exit Sub
            Else
                .MoveFirst
                Do While Not .EOF
                    strTmp = strTmp + ts(![Area]) + "/" + ts(![Quantity]) + "/#"
                    .MoveNext
                Loop
            End If
        End With
    End With
    
    With frmOuter.AdodcCaller
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + _
                          strDataPath + ";Persist Security Info=False"
        .CommandType = adCmdUnknown
        .RecordSource = "select * from Outers order by [AreaCode]"
        .Refresh
        With .Recordset
            If .RecordCount < 1 Then
                MsgBox "外勤员工信息表为空！", vbCritical + vbOKOnly, "请补充外勤信息"