标题:请帮忙检查一下程序bug
只看楼主
VBnext
Rank: 1
等 级:新手上路
帖 子:33
专家分:0
注 册:2013-4-24
结帖率:80%
 问题点数:0 回复次数:0 
请帮忙检查一下程序bug
程序目的是吧多个.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 Object



Public 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 Sub

Private 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
转换东西及数据库:
CDDlog.rar (448.55 KB)
搜索更多相关主题的帖子: files 数据库 
2013-07-17 23:26



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-417520-1-1.html




关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.275989 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved