manager.frm

连接数据库IBM DB2 Version 7的Visual Basic 源码。

    Loop
    adcLabel.Caption = "There are total " & calls & " calls,          " & abandonedcalls & " abandoned calls."
    
    Set rstRows = Nothing
    Set cmdQuery = Nothing
    Set cnn = Nothing
    adcDisplay.Enabled = True

End Sub

Private Sub cmdDays_Click()
    
    Dim strMessage As String
    Dim cnn As ADODB.Connection
    Dim cmdQuery As ADODB.Command
    Dim rstRows As ADODB.Recordset
    
    Dim controlid As String, callerid As String
    Dim voxfile As String, in_dttm As String
    Dim rd_dttm As String, caseid As String
    Dim rd_by As String
    Dim startdttm As String, enddttm As String
    
    startdttm = Format(rptStart.Value, "YYYY-MM-DD") & " 00:00:00"
    enddttm = Format(rptEnd.Value, "YYYY-MM-DD") & " 00:00:00"
    
    cmdDays.Enabled = False
    rtmDB.Sorted = False
    rtmDB.ListItems.Clear
    rtmDB.View = lvwReport
    rtmDB.ColumnHeaders.Clear
    ' Add four ColumnHeaders.
    rtmDB.ColumnHeaders.Add , , "Control ID", 1700
    rtmDB.ColumnHeaders.Add , , "CLI", 1200
    rtmDB.ColumnHeaders.Add , , "Voice Message", 1700
    rtmDB.ColumnHeaders.Add , , "Record datetime", 1700
    rtmDB.ColumnHeaders.Add , , "Proc datetime", 1700
    rtmDB.ColumnHeaders.Add , , "Proc by", 1500
    
    ' Userinfo
    Set cnn = Nothing
    strMessage = "provider=MSDASQL;driver={IBM DB2 ODBC Driver};uid=db2admin;pwd=07646513;dbalias=crms;"
    'strMessage = "provider=MSDASQL;driver={IBM DB2 ODBC Driver};uid=db2admin;pwd=db2admin;dbalias=crms;"
            
    Set cnn = New Connection
    Call cnn.Open(strMessage)
    
    Set cmdQuery = New ADODB.Command
    cmdQuery.ActiveConnection = cnn
    
    strMessage = "select controlid, callerid, voxfile, in_dttm, rd_dttm, caseid, rd_by from crms.voicemail_info where in_dttm between '" & startdttm & "' and '" & enddttm & "' order by in_dttm desc"
    cmdQuery.CommandText = strMessage
    Set rstRows = cmdQuery.Execute
    Do While Not rstRows.EOF
        controlid = IIf(IsNull(rstRows.Fields(0).Value), "", Trim(rstRows.Fields(0).Value))
        callerid = IIf(IsNull(rstRows.Fields(1).Value), "", Trim(rstRows.Fields(1).Value))
        voxfile = IIf(IsNull(rstRows.Fields(2).Value), "", Trim(rstRows.Fields(2).Value))
        in_dttm = IIf(IsNull(rstRows.Fields(3).Value), "", Format(rstRows.Fields(3).Value, "DD/MM/YYYY hh:mm"))
        rd_dttm = IIf(IsNull(rstRows.Fields(4).Value), "", Format(rstRows.Fields(4).Value, "DD/MM/YYYY hh:mm"))
        case_id = IIf(IsNull(rstRows.Fields(5).Value), "", Trim(rstRows.Fields(5).Value))
        rd_by = IIf(IsNull(rstRows.Fields(6).Value), "", Trim(rstRows.Fields(6).Value))
        
        Set xItem = rtmDB.ListItems.Add(Key:="W" & rtmDB.ListItems.Count, Text:=controlid)
        xItem.ListSubItems.Add Key:="CLI", Text:=callerid
        xItem.ListSubItems.Add Key:="Voice Message", Text:=voxfile
        xItem.ListSubItems.Add Key:="Record datetime", Text:=in_dttm
        xItem.ListSubItems.Add Key:="Proc datetime", Text:=rd_dttm
        xItem.ListSubItems.Add Key:="Proc by", Text:=rd_by
        
        rstRows.MoveNext
    Loop
    Set rstRows = Nothing
    Set cmdQuery = Nothing
    Set cnn = Nothing
    cmdDays.Enabled = True
End Sub

Private Sub Form_Load()
    
    SSInterface.Tab = 0
    
    'Transcribe
    rtmDB.Sorted = False
    rtmDB.ListItems.Clear
    rtmDB.View = lvwReport
    rtmDB.ColumnHeaders.Clear
    ' Add four ColumnHeaders.
    rtmDB.ColumnHeaders.Add , , "Control ID", 1700
    rtmDB.ColumnHeaders.Add , , "CLI", 1200
    rtmDB.ColumnHeaders.Add , , "Voice Message", 1700
    rtmDB.ColumnHeaders.Add , , "Record datetime", 1700
    rtmDB.ColumnHeaders.Add , , "Proc datetime", 1700
    rtmDB.ColumnHeaders.Add , , "Proc by", 1500
    
    rptStart.Value = DateAdd("M", -1, Now)
    rptEnd.Value = DateAdd("D", 1, Now)
    
    'Phone Code Usage
    pcuDB.Sorted = False
    pcuDB.ListItems.Clear
    pcuDB.View = lvwReport
    pcuDB.ColumnHeaders.Clear
    ' Add four ColumnHeaders.
    pcuDB.ColumnHeaders.Add , , "Control ID", 3200
    pcuDB.ColumnHeaders.Add , , "Phone Code", 2200
    pcuDB.ColumnHeaders.Add , , "Record datetime", 2700
    
    pcuStart.Value = Now
    pcuEnd.Value = DateAdd("D", 1, Now)
    
    'Abandoned Calls
    adcDB.Sorted = False
    adcDB.ListItems.Clear
    adcDB.View = lvwReport
    adcDB.ColumnHeaders.Clear
    ' Add four ColumnHeaders.
    adcDB.ColumnHeaders.Add , , "Control ID", 1700
    adcDB.ColumnHeaders.Add , , "CLI", 1000
    adcDB.ColumnHeaders.Add , , "Hour", 600
    adcDB.ColumnHeaders.Add , , "Call starttime", 1500
    adcDB.ColumnHeaders.Add , , "Queue starttime", 1500
    adcDB.ColumnHeaders.Add , , "CSO answertime", 1500
    adcDB.ColumnHeaders.Add , , "Call endtime", 1500
    adcDB.ColumnHeaders.Add , , "Leave voicemail", 700
    adcDB.ColumnHeaders.Add , , "Abondanded call", 700
    
    adcStart.Value = Now
    adcEnd.Value = DateAdd("D", 1, Now)
    
End Sub

Private Sub pcuCmd_Click()

    Dim strMessage As String
    Dim cnn As ADODB.Connection
    Dim cmdQuery As ADODB.Command
    Dim rstRows As ADODB.Recordset
    
    Dim controlid As String, lstcontrolid
    Dim phonecode As String
    Dim rd_dttm As String
    Dim calls As Long, callswithphonecode As Long, phonecodes As Long
    Dim used As Integer
    Dim startdttm As String, enddttm As String
    
    startdttm = Format(pcuStart.Value, "YYYY-MM-DD") & " 00:00:00"
    enddttm = Format(pcuEnd.Value, "YYYY-MM-DD") & " 00:00:00"
    
    pcuDB.Sorted = False
    pcuDB.ListItems.Clear
    pcuDB.View = lvwReport
    pcuDB.ColumnHeaders.Clear
    ' Add four ColumnHeaders.
    pcuDB.ColumnHeaders.Add , , "Control ID", 3200
    pcuDB.ColumnHeaders.Add , , "Phone Code", 2200
    pcuDB.ColumnHeaders.Add , , "Record datetime", 2700
    
    controlid = ""
    lstcontrolid = ""
    calls = 0
    callswithphonecode = 0
    phonecodes = 0
    ' Userinfo
    Set cnn = Nothing
    strMessage = "provider=MSDASQL;driver={IBM DB2 ODBC Driver};uid=db2admin;pwd=07646513;dbalias=crms;"
    'strMessage = "provider=MSDASQL;driver={IBM DB2 ODBC Driver};uid=db2admin;pwd=db2admin;dbalias=crms;"
            
    Set cnn = New Connection
    Call cnn.Open(strMessage)
    
    Set cmdQuery = New ADODB.Command
    cmdQuery.ActiveConnection = cnn
    
    strMessage = "select controlid, capturedigit, rec_dttm from crms.verify_digit where rec_dttm between '" & startdttm & "' and '" & enddttm & "' order by controlid desc"
    cmdQuery.CommandText = strMessage
    Set rstRows = cmdQuery.Execute
    Do While Not rstRows.EOF
        controlid = IIf(IsNull(rstRows.Fields(0).Value), "", Trim(rstRows.Fields(0).Value))
        phonecode = IIf(IsNull(rstRows.Fields(1).Value), "", Trim(rstRows.Fields(1).Value))
        rd_dttm = IIf(IsNull(rstRows.Fields(2).Value), "", Format(rstRows.Fields(2).Value, "DD/MM/YYYY hh:mm"))
        
        If controlid = lstcontrolid Then
        Else
            calls = calls + 1
            lstcontrolid = controlid
            If used = 1 Then
                callswithphonecode = callswithphonecode + 1
            End If
            used = 0
        End If
        If Len(phonecode) = 5 Then
            used = 1
            phonecodes = phonecodes + 1
            Set xItem = pcuDB.ListItems.Add(Key:="P" & pcuDB.ListItems.Count, Text:=controlid)
            xItem.ListSubItems.Add Key:="Phone Code", Text:=phonecode
            xItem.ListSubItems.Add Key:="Record datetime", Text:=rd_dttm
        End If
        
        rstRows.MoveNext
    Loop
    pcuLabel.Caption = "There are total " & calls & " calls.          " & callswithphonecode & " calls with phonecode.        Users keyin phonecode " & phonecodes & " times."
    
    Set rstRows = Nothing
    Set cmdQuery = Nothing
    Set cnn = Nothing
    pcuCmd.Enabled = True
    
End Sub

Private Sub pcuDB_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    pcuDB.SortKey = ColumnHeader.Index - 1
    ' Set Sorted to True to sort the list.
    If pcuDB.SortOrder = lvwAscending Then
        pcuDB.SortOrder = lvwDescending
    Else
        pcuDB.SortOrder = lvwAscending
    End If
    pcuDB.Sorted = True
End Sub

Private Sub pcuDB_DblClick()
    Dim xlSheet As Object
    Dim i As Integer, j As Integer
    Dim Filename As String
    
    Filename = InputBox("Enter file to save:", "File Save", "C:\Phonecode Usage.xls")
    If Filename = "" Then
        Exit Sub
    End If
    
On Error GoTo DatabaseErr
    Set xlExcelApp = CreateObject("Excel.Application")
    'create the excel workbook object for resultant file
    Set xlExcelBook = xlExcelApp.Workbooks.Add
    
    Set xlSheet = xlExcelBook.Worksheets(1)
    For i = 1 To pcuDB.ColumnHeaders.Count
        xlSheet.Cells(1, i).Value = pcuDB.ColumnHeaders(i).Text
    Next i
    For i = 1 To pcuDB.ListItems.Count
        xlSheet.Cells(i + 1, 1) = "'" & pcuDB.ListItems(i).Text
        For j = 1 To pcuDB.ColumnHeaders.Count - 1
            xlSheet.Cells(i + 1, j + 1).Value = "'" & pcuDB.ListItems(i).ListSubItems(j).Text
        Next j
    Next i
    
    xlExcelBook.SaveAs Filename
    MsgBox "Report export to " & Filename
    xlExcelBook.Save
    xlExcelBook.Close
    xlExcelApp.Quit
    Set xlSheet = Nothing
    Set xlExcelBook = Nothing
    Set xlExcelApp = Nothing
    
    Exit Sub
DatabaseErr:
    MsgBox Err.Description
End Sub

Private Sub rtmDB_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    rtmDB.SortKey = ColumnHeader.Index - 1
    ' Set Sorted to True to sort the list.
    If rtmDB.SortOrder = lvwAscending Then
        rtmDB.SortOrder = lvwDescending
    Else
        rtmDB.SortOrder = lvwAscending
    End If
    rtmDB.Sorted = True
End Sub

Private Sub rtmDB_DblClick()
    Dim xlSheet As Object
    Dim i As Integer, j As Integer
    Dim Filename As String
    
    Filename = InputBox("Enter file to save:", "File Save", "C:\Transcribe.xls")
    If Filename = "" Then
        Exit Sub
    End If
    
On Error GoTo DatabaseErr
    Set xlExcelApp = CreateObject("Excel.Application")
    'create the excel workbook object for resultant file
    Set xlExcelBook = xlExcelApp.Workbooks.Add
    
    Set xlSheet = xlExcelBook.Worksheets(1)
    For i = 1 To rtmDB.ColumnHeaders.Count
        xlSheet.Cells(1, i).Value = rtmDB.ColumnHeaders(i).Text
    Next i
    For i = 1 To rtmDB.ListItems.Count
        xlSheet.Cells(i + 1, 1) = "'" & rtmDB.ListItems(i).Text
        For j = 1 To rtmDB.ColumnHeaders.Count - 1
            xlSheet.Cells(i + 1, j + 1).Value = "'" & rtmDB.ListItems(i).ListSubItems(j).Text
        Next j
    Next i
    
    xlExcelBook.SaveAs Filename
    MsgBox "Report export to " & Filename
    xlExcelBook.Save
    xlExcelBook.Close
    xlExcelApp.Quit
    Set xlSheet = Nothing
    Set xlExcelBook = Nothing
    Set xlExcelApp = Nothing
    
    Exit Sub
DatabaseErr:
    MsgBox Err.Description
End Sub