0

i have the same problem but nit that similer
the other function works ok and no error only this function of ftp.
pls help me

Private Sub Form_Unload(Cancel As Integer)
 Timer1.Enabled = False
 FtpHDB.CloseConnection
 FtpPDB.CloseConnection
 FtpPRD.CloseConnection
 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

Edited by peter_budo: Keep It Clear - Do wrap your programming code blocks within [code] ... [/code] tags

2
Contributors
1
Reply
2
Views
6 Years
Discussion Span
Last Post by AndreRet
0

It seems we have missed your post over the new year celebrations.:)

In your code, can you show us where the error occurred?

The error normally refers to your code referencing something that does not exist when called. If I can see where the error was generated, we can get the solution from there.:)

This topic has been dead for over six months. Start a new discussion instead.
Have something to contribute to this discussion? Please be thoughtful, detailed and courteous, and be sure to adhere to our posting rules.