file.bas

某公司的电话录音程序

Attribute VB_Name = "file"
    '是否存在sound目录和oldsound目录，如果不存在则建立
    '同时建立两个目录下的各个子目录
Public Sub TestAndCreate()
Dim i As Integer
Dim j As Integer
Set fs = CreateObject("Scripting.FileSystemObject")
'建立Sound
If Not fs.folderexists(App.Path & "\sound") Then
   fs.createfolder App.Path & "\sound"
End If
'建立OldSound
If Not fs.folderexists(App.Path & "\oldsound") Then
   fs.createfolder App.Path & "\oldsound"
End If
'建立OldSound下各个子目录
For j = 0 To ChanelNum - 1
  If Not fs.folderexists(App.Path & "\oldsound\" & Str$(j)) Then
     fs.createfolder App.Path & "\oldsound\" & Str$(j)
  End If
Next j
'MsgBox Chr(48 + 0)

End Sub

Public Sub fSear()
'Dim mSign As Integer
'-1表不满足条件，应该跳转
'1表满足条件，也跳转
'0表示还无法确定
fSearchRes.Show

'根据fsearch窗体提供的条件查询数据库，结果显示在fsearchRes上
Dim fNo As Integer '结果中文件的序号
'Dim ConTrue As Boolean
Dim Sql As String
Dim i As Integer

Dim YY As String '1
Dim MO As String '2
Dim DD As String '3
Dim HH As String '4
Dim MI As String '5
Dim Ch As String '6通道
Dim St As String '状态,打入还是打出'o打出,i打入
Dim Ph As String '电话号码
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
'数据库查询
Sql = "select fName,fDate,fTime,fPassNo,phoneNo,fStatus from file order by fPassNo,fDate,fTime,fStatus"
 If Not mExecuteSql(Sql, Rs) Then
    MsgBox "数据库访问错误", vbOKOnly + vbExclamation, "错误"
    Exit Sub
 End If
 fNo = 0
While Not Rs.EOF
  
  '经过这么多道筛选如果还满足条件，则记录满足条件

      YY = Mid(Rs.Fields(0), 1, 4)
      MO = Mid(Rs.Fields(0), 5, 2)
      DD = Mid(Rs.Fields(0), 7, 2)
      HH = Mid(Rs.Fields(0), 9, 2)
      MI = Mid(Rs.Fields(0), 11, 2)
      Ch = Mid(Rs.Fields(0), 15, 1)
      St = Mid(Rs.Fields(0), 16, 1) '多了一个状态
      Ph = Mid(Rs.Fields(0), 17, NumLong)
         '开始过滤，如果有一个条件不满足则，置conTure为false
         
         With fSearch '查询条件检查
           '年比较，如果年符合则月日时就不用比较了，只有年相等的情况下才比较月日
           '先比较左边界
           If Trim(.Text1.Text) = "" Then '无左边界，年
              GoTo CheckR '跳转，检查右边界
           Else
              If Val(YY) < Val(.Text1.Text) Then '不满足条件
                  GoTo EEEEE
              ElseIf Val(YY) > Val(.Text1.Text) Then
                  GoTo CheckR '满足条件，跳转检查右边界
              End If
           End If
           '左边界月
           If Trim(.Text3.Text) = "" Then '无月左边界
               GoTo CheckR
           Else
              If Val(MO) < Val(.Text3.Text) Then
                 GoTo EEEEE
              ElseIf Val(MO) > Val(.Text3.Text) Then
                 GoTo CheckR
              End If
           End If
           '左边界日
           If Trim(.Text5.Text) = "" Then
              GoTo CheckR
           Else
              If Val(DD) < Val(.Text5.Text) Then
                 GoTo EEEEE
              ElseIf Val(DD) > Val(.Text5.Text) Then
                 GoTo CheckR
              End If
           End If
           '左边界时
           If Trim(.Text7.Text) = "" Then
              GoTo CheckR
           Else
              If Val(HH) < Val(.Text7.Text) Then
                 GoTo EEEEE
              ElseIf Val(HH) > Val(.Text7.Text) Then
                 GoTo CheckR
              End If
           End If
           '左边界分
           If Trim(.Text9.Text) = "" Then
              GoTo CheckR
           Else
              If Val(MI) < Val(.Text9.Text) Then
                 GoTo EEEEE
              ElseIf Val(MI) > Val(.Text9.Text) Then
                 GoTo CheckR
              End If
           End If
           '左边界比较完毕
           
CheckR:
           '下面比较右边界
           '年
           If Trim(.Text2.Text) = "" Then
              GoTo mGood
           Else
              If Val(YY) > Val(.Text2.Text) Then
                 GoTo EEEEE
              ElseIf Val(YY) < Val(.Text2.Text) Then
                 GoTo mGood
              End If
           End If
           '月
           If Trim(.Text4.Text) = "" Then
              GoTo mGood
           Else
              If Val(MO) > Val(.Text4.Text) Then
                  GoTo EEEEE
              ElseIf Val(MO) < Val(.Text4.Text) Then
                  GoTo mGood
              End If
           End If
           '日
           If Trim(.Text6.Text) = "" Then
              GoTo mGood
           Else
              If Val(DD) > Val(.Text6.Text) Then
                 GoTo EEEEE
              ElseIf Val(DD) < Val(.Text6.Text) Then
                 GoTo mGood
              End If
           End If
           '时
           If Trim(.Text8.Text) = "" Then
              GoTo mGood
           Else
             If Val(HH) > Val(.Text8.Text) Then
                GoTo EEEEE
             ElseIf Val(HH) < Val(.Text8.Text) Then
                GoTo mGood
             End If
           End If
           '分
           If Trim(.Text10.Text) = "" Then
              GoTo mGood
           Else
              If Val(MI) > Val(.Text10.Text) Then
                GoTo EEEEE
              ElseIf Val(HH) < Val(.Text10.Text) Then
                GoTo mGood
              End If
           End If
mGood: 'right it
   '下面比较通道和电话号码
   If Trim(.Combo1.Text) = "全部" Then
     GoTo mGood2
   ElseIf Val(.Combo1.Text) = Val(Ch) Then
     GoTo mGood2
   Else
     GoTo EEEEE
   End If
mGood2:
   '电话号码
   If Trim(.Combo2.Text) = "全部" Then
      'MsgBox .Combo2.Text
     ' GoTo mGood3
   GoTo Mstatus
   'ElseIf Val(.Combo2.Text) = Val(Ph) Then '修改一下
   ElseIf Trim(.Combo2.Text) = Trim(Ph & "") Then   '相等
   
   'MsgBox Ph & ""
   
     ' GoTo mGood3
   GoTo Mstatus
   Else
      GoTo EEEEE
   End If
   
 

   '显示结果于表中
Mstatus: '状态判断
 Dim Aa As String
 If St = "o" Then
   Aa = "打出"
 Else
   Aa = "打入"
 End If
  If Trim(.Combo3.Text = "全部") Then
  ElseIf Trim(.Combo3.Text) = Trim(Aa & "") Then
  Else
    GoTo EEEEE
  End If
End With
mGood3:
   With fSearchRes
     If .Grid1.Rows = 2 And Trim(.Grid1.TextMatrix(1, 0)) <> "" Then
        .Grid1.Rows = .Grid1.Rows + 1
     ElseIf .Grid1.Rows > 2 Then
        .Grid1.Rows = .Grid1.Rows + 1
     End If
   
   fNo = fNo + 1
   '填入表中数据
    .Grid1.TextMatrix(fNo, 0) = fNo
    .Grid1.TextMatrix(fNo, 1) = Rs.Fields(0) & ""
    .Grid1.TextMatrix(fNo, 2) = Rs.Fields(1) & ""
    .Grid1.TextMatrix(fNo, 3) = Rs.Fields(2) & ""
    .Grid1.TextMatrix(fNo, 4) = Rs.Fields(3) & ""
    .Grid1.TextMatrix(fNo, 5) = Rs.Fields(4) & ""
    .Grid1.TextMatrix(fNo, 6) = Aa
 End With
   
EEEEE:
  Rs.MoveNext
Wend
End Sub