form1.frm

修改监控文件

    Set myfile = fso.OpenTextFile(App.Path & "\fcf\每日统计.txt", ForReading)
    Do While Not myfile.AtEndOfStream
        s12 = myfile.ReadLine
        If Left(s12, 24) = "0899960000          2000" Then
            s12 = Trim(Mid(s12, 25, 12))
            t12 = t12 + 1
            arr12(t12) = s12
        End If
    Loop

    Set myfile = fso.OpenTextFile(App.Path & "\fcf\每日统计.txt", ForReading)
    Do While Not myfile.AtEndOfStream
        s13 = myfile.ReadLine
        If Left(s13, 24) = "0899960000          4000" Then
            s13 = Trim(Mid(s13, 25, 12))
            t13 = t13 + 1
            arr13(t13) = s13
        End If
    Loop

    Set myfile = fso.OpenTextFile(App.Path & "\fcf\每日统计.txt", ForReading)
    Do While Not myfile.AtEndOfStream
        s14 = myfile.ReadLine
        If Left(s14, 24) = "0899960000          4300" Then
            s14 = Trim(Mid(s14, 25, 12))
            t14 = t14 + 1
            arr14(t14) = s14
        End If
    Loop

    Set myfile = fso.OpenTextFile(App.Path & "\fcf\每日统计.txt", ForReading)
    Do While Not myfile.AtEndOfStream
        s15 = myfile.ReadLine
        If Left(s15, 24) = "0899970000          3300" Then
            s15 = Trim(Mid(s15, 25, 12))
            t15 = t15 + 1
            arr15(t15) = s15
        End If
    Loop

    Set myfile = fso.OpenTextFile(App.Path & "\fcf\每日统计.txt", ForReading)
    Do While Not myfile.AtEndOfStream
        s16 = myfile.ReadLine
        If Left(s16, 24) = "0899970000          4300" Then
            s16 = Trim(Mid(s16, 25, 12))
            t16 = t16 + 1
            arr16(t16) = s16
        End If
    Loop

    Set myfile = fso.OpenTextFile(App.Path & "\fcf\每日统计.txt", ForReading)
    Do While Not myfile.AtEndOfStream
        s17 = myfile.ReadLine
        If Left(s17, 24) = "0899970000          8100" Then
            s17 = Trim(Mid(s17, 25, 12))
            t17 = t17 + 1
            arr17(t17) = s17
        End If
    Loop

    Set myfile = fso.OpenTextFile(App.Path & "\fcf\每日统计.txt", ForReading)
    Do While Not myfile.AtEndOfStream
        s18 = myfile.ReadLine
        If Left(s18, 24) = "0899980000          2000" Then
            s18 = Trim(Mid(s18, 25, 12))
            t18 = t18 + 1
            arr18(t18) = s18
        End If
    Loop

    Set myfile = fso.OpenTextFile(App.Path & "\fcf\每日统计.txt", ForReading)
    Do While Not myfile.AtEndOfStream
        s19 = myfile.ReadLine
        If Left(s19, 24) = "0899980000          4000" Then
            s19 = Trim(Mid(s19, 25, 12))
            t19 = t19 + 1
            arr19(t19) = s19
        End If
    Loop


    excelsheet3.Cells(r, 4) = u1 + arr1(2) + vbCrLf + u2 + arr2(2) + vbCrLf + u3 + arr3(2) + vbCrLf + u4 + arr4(2) _
    + vbCrLf + u5 + arr5(2) + vbCrLf + u6 + arr6(2) + vbCrLf + u7 + arr7(2) + vbCrLf + u8 + arr8(2) + vbCrLf _
    + u9 + arr9(2) + vbCrLf + u10 + arr10(2) + vbCrLf + u11 + arr11(2) + vbCrLf + u12 + arr12(2) + vbCrLf + u13 _
    + arr13(2) + vbCrLf + u14 + arr14(2) + vbCrLf + u15 + arr15(2) + vbCrLf + u16 + arr16(2) + vbCrLf + u17 + arr17(2) _
    + vbCrLf + u18 + arr18(2) + vbCrLf + u19 + arr19(2)
 
    excelsheet3.Cells(r, 3) = u1 + arr1(1) + vbCrLf + u2 + arr2(1) + vbCrLf + u3 + arr3(1) + vbCrLf + u4 + arr4(1) _
    + vbCrLf + u5 + arr5(1) + vbCrLf + u6 + arr6(1) + vbCrLf + u7 + arr7(1) + vbCrLf + u8 + arr8(1) + vbCrLf _
    + u9 + arr9(1) + vbCrLf + u10 + arr10(1) + vbCrLf + u11 + arr11(1) + vbCrLf + u12 + arr12(1) + vbCrLf + u13 _
    + arr13(1) + vbCrLf + u14 + arr14(1) + vbCrLf + u15 + arr15(1) + vbCrLf + u16 + arr16(1) + vbCrLf + u17 + arr17(1) _
    + vbCrLf + u18 + arr18(1) + vbCrLf + u19 + arr19(1)
 
    
    myExcel.ActiveWorkbook.Save
'***************************************************************************************************************
    myExcel.Sheets("黄金前置").Select
    
    Set excelsheet = myExcel.Worksheets("黄金前置")
    r = 3
    Do While r > 2 And r < 1000
        r = r + 1
        If excelsheet.Cells(r, 2) = "" Then
        Exit Do
        End If
    Loop
    
    
    geag_1 = Trim(ReadFileLine(App.Path & "\geag\geag.txt", 3))
    geag_2 = Trim(ReadFileLine(App.Path & "\geag\geag.txt", 9))
    geag_3 = Trim(ReadFileLine(App.Path & "\geag\geag.txt", 15))
    geag_4 = Trim(ReadFileLine(App.Path & "\geag\geag.txt", 18))
    geag_5 = Trim(ReadFileLine(App.Path & "\geag\geag.txt", 22))
    
    Dim geagarray
    geagarray = Split(geag_5, "%")
    
    
    excelsheet.Cells(r, 2) = geag_1
    excelsheet.Cells(r, 4) = geag_2
    excelsheet.Cells(r, 6) = geag_3
    excelsheet.Cells(r, 8) = geag_4
    
    excelsheet.Cells(r, 9) = Trim(Right(geagarray(0), 3)) & "%"
    
    myExcel.ActiveWorkbook.Save
'*****************************************************************************************************************
    Set excelsheet = myExcel.Worksheets("电话银行")
    ccis_1 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 3))
    ccis1 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 4))
    ccis2 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 5))
    ccis_2 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 8))
    ccis3 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 9))
    ccis4 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 10))
    ccis_3 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 13))
    ccis_4 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 16))
    ccis_5 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 19))
    ccis_6 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 20))
    ccis_7 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 21))
    ccis_8 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 22))
    ccis_9 = Trim(ReadFileLine(App.Path & "\ccis\ccis.txt", 23))
    myExcel.Sheets("电话银行").Select

    r = 6
    Do While r > 5 And r < 1000
        r = r + 1
        If excelsheet.Cells(r, 2) = "" Then
        Exit Do
        End If
    Loop

    
    Dim substr1, substr2, substr3, substr4, substr5, everyline As String
    substr1 = Left(ccis_5, 5)
    substr2 = Left(ccis_6, 5)
    substr3 = Left(ccis_7, 5)
    substr4 = Left(ccis_8, 5)
    substr5 = Left(ccis_9, 5)
    excelsheet.Cells(r, 6) = ccis_1
    excelsheet.Cells(r, 7) = ccis1
    excelsheet.Cells(r, 8) = ccis2
    excelsheet.Cells(r, 9) = ccis_2
    excelsheet.Cells(r, 10) = ccis3
    excelsheet.Cells(r, 11) = ccis4
    excelsheet.Cells(r, 12) = ccis_3
    excelsheet.Cells(r, 13) = ccis_4
    excelsheet.Cells(r, 14) = substr1 + "、" + substr2 + "、" + substr3 + "、" + substr4 + "、" + substr5
    

    Set myfile = fso.OpenTextFile(App.Path & "\ccis\ccis.txt", ForReading)
  
    Do Until myfile.AtEndOfStream
        ccis_39 = Trim(myfile.ReadLine)
        excelsheet.Cells(r, 44) = ccis_39
    Loop
    Rem    If InStrB(everyline, "转座席量") > 0 Then
    Rem        Debug.Print everyline
    Rem        ccis_24 = myfile.ReadLine
    Rem        Debug.Print ccis_24
    Rem        myfile.SkipLine
    Rem        ccis_25 = Trim(myfile.ReadLine)
    Rem        Debug.Print ccis_25
    Rem        excelsheet.Cells(r, 25) = ccis_25
    Rem    End If
    Open App.Path & "\ccis\ccis.txt" For Input As #1
    While Not EOF(1)
        Line Input #1, everyline
    
        If InStrB(everyline, "海南") > 16 Then
            ccis_10 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 28) = ccis_10
        End If
            
        If InStrB(everyline, "云南") > 16 Then
            ccis_11 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 26) = ccis_11
        End If
        If InStrB(everyline, "贵州") > 16 Then
            ccis_12 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 27) = ccis_12
        End If
        If InStrB(everyline, "江西") > 16 Then
            ccis_13 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 25) = ccis_13
        End If
        If InStrB(everyline, "广西") > 16 Then
            ccis_14 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 24) = ccis_14
        End If
        If InStrB(everyline, "湖南") > 16 Then
            ccis_15 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 23) = ccis_15
        End If
        If InStrB(everyline, "安徽") > 16 Then
            ccis_16 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 22) = ccis_16
        End If
        If InStrB(everyline, "湖北") > 16 Then
            ccis_17 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 21) = ccis_17
        End If
        If InStrB(everyline, "厦门") > 16 Then
            ccis_18 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 20) = ccis_18
        End If
        If InStrB(everyline, "福建") > 16 Then
            ccis_19 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 19) = ccis_19
        End If
        If InStrB(everyline, "四川") > 16 Then
            ccis_20 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 17) = ccis_20
        End If
        If InStrB(everyline, "重庆") > 16 Then
            ccis_21 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 18) = ccis_21
        End If
        If InStrB(everyline, "江苏") > 16 Then
            Debug.Print everyline
            ccis_22 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 16) = ccis_22
        End If
        If InStrB(everyline, "上海") > 16 Then
            Debug.Print everyline
            ccis_23 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 15) = ccis_23
        End If
        
        If InStrB(everyline, "北京") > 16 Then
            ccis_24 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 29) = ccis_24
        End If
        
        If InStrB(everyline, "河北") > 16 Then
            ccis_25 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 30) = ccis_25
        End If
        
        
        If InStrB(everyline, "山西") > 16 Then
            ccis_26 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 31) = ccis_26
        End If
        
        If InStrB(everyline, "辽宁") > 16 Then
            ccis_27 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 32) = ccis_27
        End If
        
        If InStrB(everyline, "陕西") > 16 Then
            ccis_28 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 33) = ccis_28
        End If
        
        If InStrB(everyline, "黑龙江") > 16 Then
            ccis_29 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 34) = ccis_29
        End If
        
        If InStrB(everyline, "河南") > 16 Then
            ccis_30 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 35) = ccis_30
        End If
        
        If InStrB(everyline, "新疆") > 16 Then
            ccis_31 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 36) = ccis_31
        End If
        
        If InStrB(everyline, "天津") > 16 Then
            ccis_32 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 37) = ccis_32
        End If
        
        If InStrB(everyline, "吉林") > 16 Then
            ccis_33 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 38) = ccis_33
        End If
        
        If InStrB(everyline, "青岛") > 16 Then
            ccis_34 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 39) = ccis_34
        End If
        
        If InStrB(everyline, "内蒙古") > 16 Then
            ccis_35 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 40) = ccis_35
        End If
        
        If InStrB(everyline, "甘肃") > 16 Then
            ccis_36 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 41) = ccis_36
        End If
        
        If InStrB(everyline, "大连") > 16 Then
            ccis_37 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 42) = ccis_37
        End If
    
        If InStrB(everyline, "青海") > 16 Then
            ccis_38 = LTrim(Left(everyline, 10))
            excelsheet.Cells(r, 43) = ccis_38
        End If
    Wend
    Close #1

    myExcel.ActiveWorkbook.Save
    Rem myExcel.Workbooks.SaveAs App.Path + "\陆沛卿制作" & Format(StatDate.Value, "YYYYMMDD") + ".xls"
    
    myExcel.