Hi!
During the execution of my app it appears the following error:RUN TIME ERROR '40002'
08501:[Microsoft][ODBC Sql Server Driver][dbnmpntw]
When i make the debug the code has stop in the .movenext
If i continue it gives a 'Invalid state for move' error....
This is the final phase of my job and i need to succeed in this app...
If you could tell me what is wrong in this piece of code i´ll be "deeply gratefull".
This procedure has the following objectives:
For each user in the table:
-Select all distinct user names and creates an array with the user_names
-For each user it selects all respective rows from the table
-Creates an Excell Sheet and add the user´s rows to it
-Saves the sheet.
All this code(except the creation of the users array) is inside a FOR...NEXT loop.
The problem is that with resultsets of about 500 rows there´s no error.It
appens when the resultset retrieves about 5000 rows.
Doubt:Inside the FOR...NEXT,afer opening the resultset do i have to close it before
opening the next resultset?
I´m asking this because usualy,the ubound of the array=100 users and if i don´t
close the resultset after it´s finishing i open 100 resultsets!!!Is it like that???
Sub Create_Sheets()
Dim Cn As rdoConnection, Env As rdoEnvironment, conn As String, Mes As String
Dim rsltUsers As rdoResultset, total As Double, users() As String, cd As String
Dim xlApp As Excel.Application, xlBook As Excel.Workbook, xlSheet As Excel.Worksheet
Dim cnt As String, adress As String, usr As String, st As String, dt As String, hrs As String
Dim prt As String, tempo As String, rcvd As String, snt As String, pro As String
Dim sait As String, obj As String, a As Integer, risult As rdoResultset, TempoTotal As Double
Mes = Mid(Now, 4, 2)
a = 8
total = 0
Set Env = rdoEnvironments(0)
conn$ = "DSN=xxxxx;UID=;PWD=;DATAB
ASE=xxxxxx
x;"
Set Cn = Env.OpenConnection("", rdNoDriverPrompt, False, conn$)
Set xlApp = Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set rsltUsers = Cn.OpenResultset("SELECT DISTINCT USER_NAME FROM Internet WHERE FLAG = 'V' AND MESES = " & Mes - 1 & "", 2, 2, 64)
While rsltUsers.StillExecuting
DoEvents
DoEvents
Wend
With rsltUsers
.MoveFirst
Do Until .EOF
ReDim Preserve users(total)
users(total) = Trim(!USER_NAME)
total = total + 1
.MoveNext
Loop
End With
For q = 0 To UBound(users)
Set xlSheet = xlBook.Worksheets("sheet1"
)
xlApp.DisplayAlerts = False
With xlSheet
.Pictures.Insert App.Path & "\imperio.bmp"
.Cells.Font.Size = 12
.Cells.Font.Bold = True
.Cells.Borders.Color = RGB(0, 0, 0)
.Cells(7, 1).Value = "Nº OCURRÊNCIAS"
.Cells(7, 2).Value = "ENDEREÇO IP"
.Cells(7, 3).Value = "USER ID"
.Cells(7, 4).Value = "STATUS"
.Cells(7, 5).Value = "DATA"
.Cells(7, 6).Value = "HORAS"
.Cells(7, 7).Value = "PORT"
.Cells(7, 8).Value = "PROCESSAMENTO"
.Cells(7, 9).Value = "BYTES RECEBIDOS"
.Cells(7, 10).Value = "BYTES ENVIADOS"
.Cells(7, 11).Value = "PROTOCOLO"
.Cells(7, 12).Value = "SITE"
.Cells(7, 13).Value = "FONTE"
.Cells(7, 14).Value = "CODIGO"
.Cells(7, 15).Value = "TOTAL(Segundos)"
End With
Set risult = Cn.OpenResultset("SELECT * FROM Internet WHERE USER_NAME=" & _
"'" & users(q) & "'" & "And FLAG = 'V' AND " & Mes - 1 & " = MESES order by LOG_DATE", 2, 2, 64)
While risult.StillExecuting
DoEvents
DoEvents
Wend
With risult
Do
If .EOF Then Exit Do
cnt = !Contador
adress = !IP_ADDRESS
usr = !USER_NAME
st = !STATOS
dt = !LOG_DATE
hrs = !LOG_TIME
If Mid(hrs, 4, 2) >= 0 And Mid(hrs, 4, 2) <= 15 Then
Mid(hrs, 4, 2) = "00"
ElseIf Mid(hrs, 4, 2) >= 16 And Mid(hrs, 4, 2) <= 30 Then
Mid(hrs, 4, 2) = "15"
ElseIf Mid(hrs, 4, 2) >= 31 And Mid(hrs, 4, 2) <= 45 Then
Mid(hrs, 4, 2) = "30"
ElseIf Mid(hrs, 4, 2) >= 46 And Mid(hrs, 4, 2) <= 59 Then
Mid(hrs, 4, 2) = "45"
End If
prt = !DEST_PORT
tempo = !PROCESSING_TIME
rcvd = !BYTES_RECEIVED
snt = !BYTES_SENT
pro = !PROTOCOL_NAME
sait = !OBJECT_NAME
obj = !OBJECT_SOURCE
cd = !RESULT_CODE
total = !Total_Segundos
With xlSheet
.Cells(a, 1).Value = CInt(cnt)
.Cells(a, 2).Value = Trim(adress)
.Cells(a, 3).Value = Trim(usr)
.Cells(a, 4).Value = Trim(st)
.Cells(a, 5).Value = Trim(dt)
.Cells(a, 6).Value = Trim(hrs)
.Cells(a, 7).Value = Trim(prt)
.Cells(a, 8).Value = Trim(tempo)
.Cells(a, 9).Value = Trim(rcvd)
.Cells(a, 10).Value = Trim(snt)
.Cells(a, 11).Value = Trim(pro)
.Cells(a, 12).Value = Trim(sait)
.Cells(a, 13).Value = Trim(obj)
.Cells(a, 14).Value = Trim(cd)
.Cells(a, 15).Value = Format(total, "###")
For i = 1 To 15
.Cells(a, i).Font.Size = 10
.Cells(a, i).Font.Bold = False
Next i
End With
.MoveNext
a = a + 1
TempoTotal = TempoTotal + total
Loop Until .EOF
With xlSheet
.Cells(a + 2, 1).Value = "Acesso Total:"
If TempoTotal >= 60 Then
.Cells(a + 2, 2).Value = Format(TempoTotal / 60, "###.##") & " minutos"
Else
.Cells(a + 2, 2).Value = TempoTotal & " segundos"
End If
End With
End With
a = 8
TempoTotal = 0
On Error Resume Next
Kill App.Path & "\" & Trim(users(q)) & "(" & UCase(Left(Mez, 3)) & ")" & ".xls"
xlBook.SaveAs App.Path & "\" & Trim(users(q)) & "(" & UCase(Left(Mez, 3)) & ")" & ".xls"
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlBook = xlApp.Workbooks.Add
Next q
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
rsltUsers.Close
risult.Close
Cn.Close
Call MAIL_SHEETS(users, Mez)
End Sub
Rui Pedro
Lisbon,Portugal
