VB6 run time error 91

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

eprology

Thread Starter
Joined
Jan 7, 2011
Messages
2
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
 
Joined
Sep 4, 2003
Messages
4,912
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

Thread Starter
Joined
Jan 7, 2011
Messages
2
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
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Top