Solved

FTPputfile() failed in VBA

Posted on 2010-11-08
5
2,304 Views
Last Modified: 2012-05-10
Dear Eg1044 and Expert,


I would like to know in your code provide at
http://www.experts-exchange.com/OS/Microsoft_Operating_Systems/MS_DOS/Q_26566712.html#discussion,
why we need to ftpfileopen() to open since I just need upload files to the server. I run the code and found the
speed of FTP is really slow and three times slower than comparing to other softwer like pscp.exe. Is that because
you add some read file code in the subroutine or function to slow down
the upload process? Is it possible to modfiy the code to speed it up?
Each file to upload is just 10-20K only since it costs 30 seconds to upload ?

Why not using FTIPputfile() directly ? but I tried it fail .
FtpPutFile(hConnect, StrPtr(szServerFile), StrPtr(szLocalFile), FTP_TRANSFER_TYPE_UNKNOWN, 0), Why ?



Please advise

Duncan


ublic Function FtpPutFileEx( _

  ByVal szServer As String, _

  ByVal szUser As String, _

  ByVal szPassword As String, _

  ByVal szLocalFile As String, _

  ByVal szServerFile As String, _

  ByVal filetype As Long) As Boolean

  Dim dwStatus As Long

  Dim dwLoFileSize As Long

  Dim dwHiFileSize As Long

  Dim dwPercent As Long

  Dim a As Variant

  hOpen = InternetOpenW(0, INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)

 '// connect to the ftp server

  hConnect = InternetConnectW(hOpen, StrPtr(szServer), INTERNET_DEFAULT_FTP_PORT, _

    StrPtr(szUser), _

    StrPtr(szPassword), INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)

    If hConnect = 0 Then

    CleanUp

    Debug.Print "InternetConnectW()" & Err.LastDllError

    FtpPutFileEx = False

    Exit Function

  End If

'  Dim success As Boolean

 ' success = False

 ' Do Until success = True

  

 ' success = FtpPutFile(hConnect, StrPtr(szServerFile), StrPtr(szLocalFile), FTP_TRANSFER_TYPE_UNKNOWN, 0)

 ' Loop

 '  Exit Function

 

    'MsgBox GetCurrentDirectory

  '// get handle for filename that will be written to the ftp server

  'Call FtpSetCurrentDirectory(hConnect, sdir)



 ' a = Time()

 ' Do Until hInternet <> 0 Or TimeValue(Time()) - TimeValue(a) > TimeValue("00:00:59")

  hInternet = FtpOpenFileW(hConnect, StrPtr(szServerFile), GENERIC_WRITE, filetype, 0)

 ' Loop

  

  If hInternet = 0 Then

    CleanUp

    Debug.Print "FtpOpenFile()" & Err.LastDllError

     FtpPutFileEx = False

    Exit Function

  End If

   

  '// get handle for local file to read bytes

  hFile = CreateFileW(StrPtr("\\?\" & szLocalFile), GENERIC_READ, 0, 0, OPEN_EXISTING, 0, 0)

   

  If hFile = INVALID_HANDLE_VALUE Then

    CleanUp

    Debug.Print "CreateFileW()" & Err.LastDllError

     FtpPutFileEx = False

    Exit Function

  End If

  

  ' // get local file size for progress. This example supports

  '    only up to 2GB of status reporting progress.

  dwLoFileSize = GetFileSize(hFile, dwHiFileSize)

  

  '// read local file, write server file bytes

  Do

    If ReadFile(hFile, VarPtr(Buffer(0)), BUF_SIZE, dwReadBytes, 0) Then

      If InternetWriteFile(hInternet, VarPtr(Buffer(0)), dwReadBytes, dwWrittenBytes) Then

        ' Track the amount of bytes written and percentage.

        dwStatus = (dwStatus + dwWrittenBytes)

        dwPercent = (dwStatus / dwLoFileSize) * 100

        'Label1.Caption = dwPercent

      End If

    Else

      Exit Do

    End If

    DoEvents

  Loop Until dwReadBytes = 0

    FtpPutFileEx = True

  Debug.Print "Done"

  '// cleanup

  CleanUp

  Erase Buffer

   

  

End Function



Private Sub CleanUp()

   

  If hOpen <> 0 Then

    InternetCloseHandle hOpen

    hOpen = 0

  End If

  If hConnect <> 0 Then

    InternetCloseHandle hConnect

    hConnect = 0

  End If

  If hInternet <> 0 Then

    InternetCloseHandle hInternet

    hInternet = 0

  End If

  If hFile > 0 Then

    CloseHandle hFile

    hFile = INVALID_HANDLE_VALUE

  End If

   

End Sub

Open in new window

0
Comment
Question by:duncanb7
  • 3
  • 2
5 Comments
 
LVL 29

Accepted Solution

by:
nffvrxqgrcfqvvc earned 500 total points
ID: 34085845
It shouldn't take that long for such a small file unless the connection can't be established to the server. You changed the original code and added a bunch of loops where they shouldn't be placed. I don't know how your timing the upload but what your example shows is not the correct way to time the upload. There is a difference between the methods, FtpPutFile() is going to block the thread until the file has been uploaded. The other example allows messages to still pump to any UI and it also has complete control over the buffer, read operations, and gives byte information if you need to report progress none of which FtpPutFile() will give you. FtpPutFile() also uses the default FTP buffer size which is 4KB. The problem is most likely with your connection to the internet, server or firewall.
Example using FtpPutFile() .. be warned thread will block until file is completed.

Option Explicit



Private Const FTP_TRANSFER_TYPE_UNKNOWN As Long = 0

Private Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0

Private Const INTERNET_FLAG_PASSIVE As Long = &H8000000

Private Const INTERNET_DEFAULT_FTP_PORT As Long = 21

Private Const INTERNET_SERVICE_FTP As Long = 1

 

Private Declare Function InternetOpenW Lib "wininet" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxyName As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long

Private Declare Function InternetConnectW Lib "wininet" (ByVal hInternetSession As Long, ByVal sServerName As Long, ByVal nServerPort As Long, ByVal sUsername As Long, ByVal sPassword As Long, ByVal lService As Long, ByVal lFlags As Long, ByVal lcontext As Long) As Long

Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInternet As Long) As Long

Private Declare Function FtpPutFileW Lib "wininet" (ByVal hConnect As Long, ByVal lpszLocalFile As Long, ByVal lpszNewRemoteFile As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long



Dim hOpen                   As Long

Dim hConnect                As Long



Public Function FtpUploadFile( _

    ByVal server As String, _

    ByVal username As String, _

    ByVal password As String, _

    ByVal localFile As String, _

    ByVal remoteFile As String) As Boolean

    

    Dim fOk As Long

    

    hOpen = InternetOpenW(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0)

    

    hConnect = InternetConnectW(hOpen, _

                                    StrPtr(server), _

                                    INTERNET_DEFAULT_FTP_PORT, _

                                    StrPtr(username), _

                                    StrPtr(password), _

                                    INTERNET_SERVICE_FTP, _

                                    INTERNET_FLAG_PASSIVE, 0)

    If hConnect = 0 Then

        Debug.Print "InternetConnect failed."; Err.LastDllError

        CleanUp

        Exit Function

    End If

    

    fOk = FtpPutFileW(hConnect, _

        StrPtr(localFile), _

        StrPtr(remoteFile), _

        FTP_TRANSFER_TYPE_UNKNOWN, 0)

        

    CleanUp

    FtpUploadFile = fOk

End Function



Private Sub CleanUp()

  If hOpen <> 0 Then

    InternetCloseHandle hOpen

    hOpen = 0

  End If

  If hConnect <> 0 Then

    InternetCloseHandle hConnect

    hConnect = 0

  End If

End Sub





Private Sub Form_Load()

    FtpUploadFile "ftp.server.com", "user", "pass", "c:\windows\system32\calc.exe", "/calc.exe"

End Sub

Open in new window

0
 
LVL 13

Author Comment

by:duncanb7
ID: 34091141
THe looping code I put in your code  that is only for testing and it  doesn't run Thanks, I change the buffer size to 65k that get it faster as normal.

Hope you can asnwer me following question kindly
1-I still have question why you put hInternet = FtpOpenFileW(hConnect, StrPtr(szServerFile), GENERIC_WRITE, FTP_TRANSFER_TYPE_UNKNOWN, 0) in your  FtpPutFileEx ()  ?whether your code is for both upload and download,
otherwise you open szServer file is for what reasn ?
 If I just need upload could I delete the those realted code like

2- I try to use application.ontime  like as follows, ontime function is wokring and calling
the macro but it is still calling one by one, only second call is running until
 the first of call ftpputfileEX is completed. Do you think any suggestion to let those
calling macro running at mutiltasking in order to speed up ftp upload ?
And I get other suggestion if ontime function is single tasking and I could try to
put the macro in new excel application and put it in the Thisworkbook  and call
it at commandline with var1,var2,var3,var3 by shell command in VBA
like shell("ftpfile.xls var1, var2, var3, var4, Readonlymode", 0). And then looping shell
with different files name in order to simulate the mutltasking to ftp files. How do you think ?

Sub test()
Dim i as integer,var1 as string, var2  as string, var3 as string, var4 3, as string
Do until var1=""
var1= Range("A"&i)
var2= Range("B"&i)
var3= Range("C"&i)
var4=range("D"&i)

 Call Application.OnTime(DateAdd("s", 10, Now()), "'FtpputfileEX" & var1 & var2 & var3 & var4'"
i=i+1
loop






  

Open in new window

0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 34091413
You don't want to remove the line because it creates the file on the ftp server it also is required to use InternetWriteFile. Think of it this way FtpOpenFile() is similar to Open "file.txt" for output as #1 (but rather its for working for ftp not local file system)
0
 
LVL 13

Author Closing Comment

by:duncanb7
ID: 34091546
Thanks for your reply

Duncan
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 34093902
Duncan, I read your recent question, you appear to be uploading more than one file. You may want to seperate the connection and uploading so you only connect to the ftp server once and not 50 times as in the example.
The examples I showed will connect to server upload one file and disconnect. You may want to connect once then perform all uploads then disconnect it could increase the performance.
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now