# VB6 run time error 91



## eprology (Jan 7, 2011)

i have a problem whit my code.
using the ftp
other fuction works ok but only this fuction have error.
the code are the same whit other button.
i continue this projec from another person so i don't realy know the actual thing.
i have read some forums but still cannot resolve
anybody pls help.

Private Sub Form_Unload(Cancel As Integer)
Timer1.Enabled = False
FtpHDB.CloseConnection <<Debug but can be use
FtpPDB.CloseConnection
FtpPRD.CloseConnection << Cannot be use
FtpRDB.CloseConnection
FtpMID.CloseConnection
Set FtpHDB = Nothing
Set FtpPDB = Nothing
Set FtpPRD = Nothing
Set FtpRDB = Nothing
Set FtpMID = Nothing
DB.Close
Set DB = Nothing
Winsock2.Close
Winsock1.Close
Sys_LOG "FTPSTD stopped."
End
End Sub
_______________________________________________

'###############################################
'# PRD PART
'###############################################
Function Connect_PRD() As Boolean
Dim PassWord As String
Dim RTVL As String * 20
Dim StrLen As Integer

Set FtpPRD = New cFTP
FtpPRD.SetModeActive
FtpPRD.SetTransferASCII
StrLen = GetPrivateProfileString("FTPSTD", "maesmes", "0", RTVL, 21, CurDir & "\CONFIG.INI")
PassWord = Left(RTVL, StrLen)
If FtpPRD.OpenConnection("mux013", "maesmes", PassWord) Then
If FtpPRD.SetFTPDirectory("stdlist/" & Format(Date, "yyyy.mm.dd")) Then
Connect_PRD = True
Prd_Conn = True
Else
FtpPRD.SetFTPDirectory PRD_DIR
End If
Else
Connect_PRD = False
Prd_Conn = False
End If
End Function
Function PRD_GetSTD(STD_DATE As Date) As Boolean
Dim Item As cDirItem
Dim DBstdREC As ADODB.Recordset
Dim iCOUNT As Integer
If FtpPRD.SetFTPDirectory(PRD_DIR & "/" & (Format(STD_DATE, "yyyy.mm.dd"))) Then
Label4.Caption = "MAESPRD : " & FtpPRD.GetFTPDirectory
DoEvents
FtpPRD.GetDirectoryListing "O*"
Set DBstdREC = New ADODB.Recordset
DBstdREC.Open "SELECT * FROM TABLE1 WHERE APPL='MAESPRD' AND PATH LIKE '%" & Format(STD_DATE, "DD-MMM-YY") & "%'", DB, adOpenStatic, adLockOptimistic
For Each Item In FtpPRD.Directory
DBstdREC.Filter = "PATH like '%" & Item.Filename & "%'"
If DBstdREC.RecordCount = 0 Then 'if stdlist not in DB then transfer
FtpPRD.SimpleFTPGetFile App.Path & "\Received\maesprd\" & Item.Filename, Item.Filename
End If
Next
PRD_GetSTD = True
Else
PRD_GetSTD = False
Exit Function
End If

Set DBstdREC = New ADODB.Recordset
DBstdREC.Open "SELECT * FROM T_FWSTD WHERE NODE='MAESPRD'", DB, adOpenStatic, adLockOptimistic
While Not DBstdREC.EOF
If FtpPRD.SimpleFTPGetFile(App.Path & "\Received\maesprd\" & DBstdREC!STD_NAME, PRD_DIR & "/" & Format(DBstdREC!S_DATE, "yyyy.mm.dd") & "/" & DBstdREC!STD_NAME) Then
On Error GoTo Error_PART
'DB.Execute "DELETE FROM TABLE1 WHERE APPL='" & DBstdREC!Node & "' AND PATH LIKE '%" & Format(DBstdREC!S_DATE, "DD-MMM-YY") & "\" & DBstdREC!STD_NAME & "%' "
If Dir(App.Path & "\maesprd\" & Format(DBstdREC!S_DATE, "DD-MMM-YY") & "\" & DBstdREC!STD_NAME) <> "" Then Kill App.Path & "\maesprd\" & Format(DBstdREC!S_DATE, "DD-MMM-YY") & "\" & DBstdREC!STD_NAME
DB.Execute "DELETE FROM T_FWSTD WHERE NODE='" & DBstdREC!Node & "' AND STD_NAME='" & DBstdREC!STD_NAME & "'"
End If

DBstdREC.MoveNext
Wend
Label4.Caption = "MAESPRD : " & FtpPRD.GetFTPDirectory
Exit Function
Error_PART:
iCOUNT = iCOUNT + 1
If iCOUNT > 30 Then Exit Function
Sys_LOG Err.Number & " : MAESPRD : " & Err.Description
Sleep 10000
Resume
End Function


----------



## Rollin_Again (Sep 4, 2003)

Which line of code is highlighted when the error occurs? It sounds to me like you are missing reference to a particular object library.

Rollin


----------



## eprology (Jan 7, 2011)

FtpHDB.CloseConnection

but this funtion run ok,the problem is the PRD funtion.
i don't realy understand why it debug at this connection.
pls help


----------

