Hi,
My requirement is this : There will be files named *.btn and *.btd in a folder in local machine which should be uploaded to a remote server. I have used the inet control and have the following code. the problem is --- the application stops with a message " STILL EXECUTING THE LAST ". when i say ok one more file is uploaded and again the message appears. if i keep clicking F8 the application runs and completes the upload. I have tried giving sleep() and other timers to slow down but not successful. Kindly help.
Private Sub cmdUpload_Click()
Dim host_name As String
Dim BATCHFolder As String
Dim IntI As Integer
Dim strtemp As String
Dim strtemp1 As String
Dim intInd As Integer
Dim IntJ As Integer
Dim str As String
Dim str1 As String
Dim str2 As String
Dim OBJ As Object
Dim putboth As Boolean
Dim transferstatus As Boolean
Dim FOBJ As Object
'On Error GoTo exit_upload
Enabled = False
MousePointer = vbHourglass
txtResults.Text = "Working"
txtResults.SelStart = Len(txtResults.Text)
DoEvents
host_name = txtHost.Text
If LCase$(Left$(host_name, 6)) <> "ftp://" Then host_name = "ftp://" & host_name
inetFTP.URL = host_name
inetFTP.UserName = txtUserName.Text
inetFTP.Password = txtPassword.Text
BATCHFolder = BATCHDIR
With FileBatchBtn
.Path = BATCHFolder ' (c:\batch\)
.Pattern = "*.btn" ' ( mahesh.btn )
.Refresh
For IntI = 0 To .ListCount - 1
putboth = False
.ListIndex = IntI
txtLocalFile.Text = BATCHFolder & .filename
txtRemoteFile.Text = .filename
str = txtLocalFile.Text
str1 = txtRemoteFile.Text
inetFTP.Execute , "Put " & str & " " & str1
str = Replace(str, ".btn", ".btd") ' (mahesh.btd)
str1 = Replace(str1, ".btn", ".btd")
inetFTP.Execute , "Put " & str & " " & str1
' putboth = True
' If putboth = True Then
' Call FOBJ.CreateFile(str = Replace(str, ".btd", ".DON"))
' MsgBox str
' End If
Next IntI
End With
m_GettingDir = True
'inetFTP.Execute , "Dir"
exit_upload:
If Err <> 0 Then
MsgBox Err.Description
End If
End Sub
----------------------------------------------
Private Sub inetFTP_StateChanged(ByVal State As Integer)
Select Case State
Case icError
AddMessage "Error: " & _
" " & inetFTP.ResponseCode & vbCrLf & _
" " & inetFTP.ResponseInfo
Case icNone
AddMessage "None"
Case icConnecting
AddMessage "Connecting"
Case icConnected
AddMessage "Connected"
Case icDisconnecting
AddMessage "Disconnecting"
Case icDisconnected
AddMessage "Disconnected"
Case icRequestSent
AddMessage "Request Sent"
Case icRequesting
AddMessage "Requesting"
Case icReceivingResponse
AddMessage "Receiving Response"
Case icRequestSent
AddMessage "Request Sent"
Case icResponseReceived
AddMessage "Response Received"
Case icResolvingHost
AddMessage "Resolving Host"
Case icHostResolved
AddMessage "Host Resolved"
Case icResponseCompleted
AddMessage inetFTP.ResponseInfo
If m_GettingDir Then
Dim txt As String
Dim chunk As Variant
m_GettingDir = False
' Get the first chunk.
chunk = inetFTP.GetChunk(1024, icString)
DoEvents
Do While Len(chunk) > 0
txt = txt & chunk
chunk = inetFTP.GetChunk(1024, icString)
DoEvents
Loop
AddMessage "----------"
AddMessage txt
End If
Case Else
AddMessage "State = " & Format$(State)
End Select
Enabled = True
MousePointer = vbDefault
End Sub
Can anyone kindly help ?
thanks and Regards
Mahesh
No one has replied yet! Why not be the first?
Sign in or Join us (it's free).