请帮忙检查一下程序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)