db.bas

某公司的电话录音程序

Attribute VB_Name = "db"
Sub ConnectionDB()
'数据库的连接
Dim CString As String
Set Cnn = New ADODB.Connection
CString = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=admin;Data Source=" + App.Path + "\file.mdb;Mode=ReadWrite|Share Deny None;Persist Security Info=False"
With Cnn
.ConnectionString = CString
.Open
End With

End Sub
Sub CloseDB()
'断开数据库的连接
Cnn.Close
End Sub
Public Function mExecuteSql(Sql As String, Rs As ADODB.Recordset) As Boolean
Dim i As Integer
i = 0
Be:
On Error GoTo Err1 '发生异常，有可能是还没生连接
'Call ConnectionDB

Dim First3 As String
First3 = Left(Sql, 3)
LCase (First3) '大写转换成小写

If First3 = "sel" Then
   Rs.Open Sql, Cnn
   
ElseIf First3 = "del" Or First3 = "upd" Or First3 = "ins" Then
Cnn.Execute Sql
End If

'Cnn.Execute sql ''''''''''?对不对？'结果删除可以
mExecuteSql = True '执行成功
GoTo MEnd
Err1: '重新连接

If i = 0 Then '只连一次，如果还错那就不是连结的问题了
   Call ConnectionDB
   i = 1
   Resume Be
End If
'''错误信息显示
Dim Msg As String
If Err.Number <> 0 Then
   Msg = "Error # " & Str(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & Err.Description
   MsgBox "错误信息:" & Msg, , "Error", Err.HelpFile, Err.HelpContext
End If
'''''''''''''''
mExecuteSql = False '执行失败
MEnd:
End Function

Sub updateDB()
'根据oldsound下实际存在的文件来更新数据库
Dim Rs As ADODB.Recordset
Set Rs = New ADODB.Recordset
Dim fs, f, f1, fc, s
Dim i As Integer
Dim j As Integer
Dim Sql As String
Dim mDate As String
Dim mTime As String
Dim mChanel As String
Dim mPhone As String
Dim mfStatus As String
' mTime, mChanel, mPhone As String
Call TestAndCreate

      '把数据库清空
          Sql = "delete from file"
          If Not mExecuteSql(Sql, Rs) Then MsgBox "数据库访问错误"
          
Set fs = CreateObject("Scripting.FileSystemObject")
    For i = 0 To ChanelNum - 1
      Set f = fs.GetFolder(App.Path & "\oldsound\" & Str$(i))
      Set fc = f.Files
      For Each f1 In fc
        'f1.Name
        's = s & vbCrLf
        '获得该文件的创建日期和时间，然后把它显示在表格中
       '   fNum = fNum + 1 '得到行号
      '获得该文件的创建日期和时间
          'mTime = Format(f1.datecreated, "YYYY-MM-DD HH:MM:SS")
          DepartfName f1.Name, mDate, mTime, mChanel, mPhone, NumLong, mfStatus '''''''''''''''问题
      '把这个文件的信息插到数据库中
          Sql = "insert into file(fName,fDate,fTime,fPassNo,phoneNo,fStatus) values('"
          Sql = Sql & f1.Name & "','"
          Sql = Sql & mDate & "','"
          Sql = Sql & mTime & "','"
          Sql = Sql & mChanel & "','"
          Sql = Sql & mPhone & "','"
          Sql = Sql & mfStatus & "')" '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''问题
       '   MsgBox sql
          If Not mExecuteSql(Sql, Rs) Then MsgBox "数据库访问错误", vbOKOnly + vbCritical, "错误"
       '   If grid1.Rows = 2 And Trim(grid1.TextMatrix(1, 1)) = "" Then
        '      grid1.TextMatrix(1, 0) = fNum
        '      grid1.TextMatrix(1, 1) = f1.Name
        '      grid1.TextMatrix(1, 2) = Mid(mTime, 1, 10)
        '      grid1.TextMatrix(1, 3) = Mid(mTime, 12, 8)
        '      grid1.TextMatrix(1, 4) = i '通道号
        '  Else
        '  grid1.Rows = grid1.Rows + 1 '增加一行
        '      grid1.TextMatrix(grid1.Rows - 1, 0) = fNum
        '      grid1.TextMatrix(grid1.Rows - 1, 1) = f1.Name
        '      grid1.TextMatrix(grid1.Rows - 1, 2) = Mid(mTime, 1, 10)
        '      grid1.TextMatrix(grid1.Rows - 1, 3) = Mid(mTime, 12, 8)
        '      grid1.TextMatrix(grid1.Rows - 1, 4) = i '通道号
        '  End If
       Next
    Next i

End Sub