程序目的是吧多个.log文件导入到Access书库中,读取第一个log没有问题第二个就出问题了
还有自己刚接触数据库和VB许多东西不懂
大家帮帮忙
程序如下:Option Explicit
'Public a() As String
Public filemanyaddress, files, strfilename, fn, ln, I
Public k, l, n, t
Public strtemp As String, MyStr As String
Public flag As Boolean
'Public frArray() As String, temp(10) As String
Public fso As Object
Public inputFile As ObjectPublic Sub mdbcon() '连接Access数据库
 conn.Open "Provider=Microsoft.jet.OLEDB.4.0;Date Source=" & App.Path & "\db1.mdb;Persist Security Info=False"
 conn.CursorLocation = adUseClient
End Sub
Public Sub xlscon() ' 连接Excel
Set cn = New ADODB.Connection
    With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=" & fnl & "_" & "Extended Properties=Excel 8.O;"
    .CursorLocation = adUseClient ' 声明游标类型
'    .Open
'    EndWith
End SubPrivate Sub Command1_Click()
Dim a() As String
'Dim filemanyaddress, files, strfilename, fn, ln, I
'Dim k, l, n, t
'Dim strtemp As String, MyStr As String
'Dim flag As Boolean
'Dim frArray() As String, temp(10) As String
'Dim fso As Object
'Dim inputFile As Object
    t = Timer
    With CommonDialog1
        .DialogTitle = "打开"
        .CancelError = False
        .Filter = "all log (*.log)|*.*"
        .Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer
        .ShowOpen
        If Len(.FileName) = 0 Then
          Exit Sub
        End If
          filemanyaddress = .FileName
    End With
    
    files = Split(filemanyaddress, Chr(0))
    ReDim a(UBound(files))
    For I = 1 To UBound(files)
        a(I) = files(0) & "\" & files(I)
    Next I
    conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\CDD.mdb;Persist Security Info=False"
    conn.Open
 For fn = 1 To UBound(a)
      
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set inputFile = fso.OpenTextFile(a(fn))
     Do While Not inputFile.atEndOfStream
       MyStr = inputFile.readLine()        Select Case MyStr
 
            Case "<RLCFP:CELL=ALL;"
'    --------------------------------------------------------------------------------------------------------
              Call RLCFP            Case "<RLNRP:CELL=ALL"            Case "<RLDEP:CELL=ALL"
         End Select
     Loop
    inputFile.Close
    Set rs = Nothing
    Set fso = Nothing
    Set inputFile = Nothing
 Next fn
  Set conn = Nothing
End Sub
Sub RLCFP()
 Dim frArray() As String, temp(10) As String
              Set rs = New ADODB.Recordset
             rs.Open "select *from [RLCFP]", conn, 1, 3
             rs.AddNew
'    --------------------------------------------------------------------------------------------------------
              Do While Not inputFile.atEndOfStream
                MyStr = inputFile.readLine()                    If MyStr = "END" Then Exit Sub
                    If MyStr = "CELL" Then temp(1) = inputFile.readLine()
                    If MyStr = "CHGR   SCTYPE    SDCCH   SDCCHAC   TN   CBCH     HSN   HOP  DCHNO" Then                          Do While Not inputFile.atEndOfStream
                                MyStr = inputFile.readLine()
                                   flag = False
                                   If Len(MyStr) = 64 Then flag = True '    ---------------------------------------------装载数据库------------------------------------------------------                                    Do While InStr(Trim(MyStr), "  ")
                                       MyStr = Replace(Trim(MyStr), "  ", " ")
                                    Loop
'                                    MsgBox (MyStr)
                                    frArray = Split(Trim(MyStr), " ")                                    If UBound(frArray) >= 7 Then
                                        ln = ln + 1
                                     End If
                                     If ln >= 2 Or Len(MyStr) = 0 Then
                                           rs(0).Value = Left(files(fn), Len(files(fn)) - 4)
                                           For k = 1 To 10
                                             rs(k).Value = Trim(temp(k))
                                           Next k
                                           ln = 0
                                           rs.AddNew
                                     End If
                                   If Len(MyStr) = 0 Then Exit Sub
                                   If MyStr = "END" Or MyStr = "FAULT INTERRUPT" Then Exit Sub
                                      If UBound(frArray) = 8 Then
                                            For l = 0 To 8
                                             temp(l + 2) = Trim(frArray(l))
                                            Next l
                                      ElseIf UBound(frArray) = 7 Then
                                            temp(2) = Trim(frArray(0))
                                            temp(3) = " "
                                            For n = 1 To 7
                                             temp(n + 3) = Trim(frArray(n))
                                            Next n
                                      ElseIf UBound(frArray) = 1 Then
                                           temp(6) = temp(6) & " " & Trim(frArray(0))
                                           temp(10) = temp(10) & " " & Trim(frArray(1))
                                      ElseIf flag = True Then
                                           temp(10) = temp(10) & " " & Trim(frArray(0))
                                      Else
                                           temp(6) = temp(6) & " " & Trim(frArray(0))
                                      End If
                        Loop                    End If               Loop
End Sub转换东西及数据库:附件还上传不了,产考地址:http://bbs.bccn.net/viewthread.php?tid=417520&extra=page%3D1&frombbs=1VBString