FTP download to Access (1 Viewer)

sumdumgai

Registered User.
Local time
Yesterday, 23:24
Joined
Jul 19, 2007
Messages
453
I'm trying to download a set of text files from a remote server using VBA and have been getting various errors. Latest is run-time error 430. Here's my code (which I lifted from an example on internet) which I hope someone can adjust to make work. Thanks in advance. 'servername', 'userid' and 'password' are not actual. Port number must be 22 when using FTP software packages. I have included msinet.ocx in References library and get clean compiles.

Code:
Sub ftptest()
    Dim DidIGetIt As Boolean
    DownloadFile "sftp.servername.com", "userid", "password", 22, _
    "g:\home\mast.txt", _
    "c:\Temp\mast.txt"
    MsgBox DidIGetIt
End Sub
 
Function DownloadFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal port As Integer, _
ByVal RemoteFileName As String, _
ByVal LocalFileName As String) As Boolean
 
Dim FTP As Inet
Set FTP = Nothing
Set FTP = New Inet
    With FTP
        .Protocol = icFTP
        '.Protocol = 2
        .RemoteHost = HostName
        .UserName = UserName
        .Password = Password
        .RemotePort = 22
        .Execute .URL, "Get " + RemoteFileName + " " + LocalFileName
        Do While .StillExecuting
        DoEvents
            Loop
        DownloadFile = (.ResponseCode = 0)
    End With
Set FTP = Nothing
End Function
 

sumdumgai

Registered User.
Local time
Yesterday, 23:24
Joined
Jul 19, 2007
Messages
453
More info. If I remove the first 'Set FTP = Nothing and rexecute, I get run-time error 35754 at 'Execute' line.
 

ajetrumpet

Banned
Local time
Yesterday, 22:24
Joined
Jun 22, 2007
Messages
5,638
i recognize the code you are using. During my searches I found similar stuff about using INET. I never did get it to work, but I found the following stuff that DOES work for me. I'll post it for you (any code you see about "LIST1", that is for my app, as I use listboxes to view remote folder contents and local folder contents at the same time - you can ignore this stuff if you use this code):

Decs Section of the form I use:
Code:
Option Explicit

'persistent handle to the internet
Private hInternet As Long

'persistent handle internet connection
Private hConnect As Long

'constants are more efficient than literals
'when used in several places
Private Const sRootDots = ".."
Private Const sSlash = "/"


To open a remote connection:
Code:
sFtpUserName = [COLOR="Red"]USERNAME[/COLOR]
sFtpPassword = [COLOR="Red"]PASSWORD[/COLOR]
sFtpHostName = [COLOR="Red"]SERVERNAME OR ADDRESS[/COLOR]

   Dim sServerName As String
   
  'Show the wait cursor
   Screen.MousePointer = 11
   
  'Begin the FTP process by obtaining a
  'handle to an internet session. This
  'handle will be used in subsequent calls,
  'so it is declared as a form-wide variable.
   hInternet = InternetOpen("VBnet FTP Transfer", _
                             INTERNET_OPEN_TYPE_DIRECT, _
                             vbNullString, _
                             vbNullString, _
                             INTERNET_FLAG_NO_CACHE_WRITE)
   
  'If a handle was obtained, the next step is
  'to obtain a connection handle that will be
  'used for all operations except the FTP
  'directory navigation. The MSDN states that
  'the handle used by FtpFindFirstFile and subsequent
  'file calls can not be reused for additional
  'navigation or other operations. This handle
  'then will be used for all functions except
  'the directory listings.
   If hInternet Then
   
      sServerName = [COLOR="Red"]SERVERNAME OR ADDRESS[/COLOR]
            
     'and get a connection handle
      hConnect = InternetConnect(hInternet, _
                                 sServerName, _
                                 INTERNET_DEFAULT_FTP_PORT, _
                                 sFtpUserName, _
                                 sFtpPassword, _
                                 INTERNET_SERVICE_FTP, _
                                 INTERNET_FLAG_EXISTING_CONNECT Or _
                                 INTERNET_FLAG_PASSIVE, _
                                 &H0)
   
     'if the connection handle is valid, get
     'the current FTP directory
      If hConnect <> 0 Then
      
         RemoteDir = sFtpHostName & GetFTPDirectory(hConnect)

      Else
      
        'show the error
         msgbox(GetErr(Err.LastDllError))

      End If
      
   End If
      
   Call GetFTPDirectoryContents
         
   Screen.MousePointer = 0


To download a file:
Code:
If hConnect = 0 Then
   MsgBox "You are not currently connected to FTP."
      Exit Sub
End If

   Dim i As Integer
   Dim sRemoteFile As String
   Dim sNewFile As String
   Dim sFile As String
   Dim sCurrDir As String
    
  'Show the wait cursor
   Screen.MousePointer = 11
   
  'Only if a valid connection...
   If hConnect Then
      
     'get the current directory and
     'selected list item
      sCurrDir = GetFTPDirectory(hConnect)

      sFile = [COLOR="red"]FILE NAME[/COLOR]
      
     'build the necessary strings. The
     'directory is qualified, so contains
     'the terminating slash.
     '
     'Change sNewFile to a valid path
     'on your system!
      sRemoteFile = sCurrDir & sFile
      sNewFile = [COLOR="red"]LOCAL DIRECTORY YOU WANT FOR STORAGE[/COLOR] & sFile
      
     'download the file
      If FtpGetFile(hConnect, _
                    sRemoteFile, _
                    sNewFile, _
                    False, _
                    FILE_ATTRIBUTE_ARCHIVE, _
                    FTP_TRANSFER_TYPE_UNKNOWN, _
                    0&) Then
                    
      Else
      
        'show any error
         msgbox(GetErr(Err.LastDllError))
      
      End If  'If FtpGetFile
   End If  'If hConnect

   Screen.MousePointer = 0


Other functions and subs that I have behind my form:
Code:
Private Function GetFTPDirectory(hConnect As Long) As String

   Dim nCurrDir As Long
   Dim sCurrDir As String
   
  'FtpGetCurrentDirectory retrieves the current
  'directory for the connection. Using this API
  'means its not necessary to track the directory
  'hierarchy for navigation.
  
  'pad the requisite buffer
   sCurrDir = Space$(MAX_PATH)
   nCurrDir = Len(sCurrDir)
      
  'returns 1 if successful
   If FtpGetCurrentDirectory(hConnect, sCurrDir, nCurrDir) = 1 Then
      
     'return a properly qualified path
      sCurrDir = StripNull(sCurrDir)
      
      If Right$(sCurrDir, 1) <> sSlash Then
         GetFTPDirectory = sCurrDir & sSlash
      Else
         GetFTPDirectory = sCurrDir
      End If
      
   End If

End Function


Private Sub GetFTPDirectoryContents()

   Dim WFD As WIN32_FIND_DATA
   Dim sPath As String
   Dim hFindConnect As Long
   Dim hFind As Long
   Dim sFileSize As String
   Dim tmp As String
   
  'Show the wait cursor
   Screen.MousePointer = 11

  'Obtain the current FTP path
   sPath = GetFTPDirectory(hConnect)
   
  'If the path is not the FTP base directory,
  'add ".." to provide a means of navigating
  'back up the directory structure. (Note: I added this
  'for use on a localhost test - in testing on some
  'sites I found that they returned '.' and '..' as
  'folders, so ideally a check would want to be made
  'in the GetFolders method to avoid loading duplicates.)
   
   
   'THIS LINE ADDS THE DOTS FOR DIRECTORY BACKUP
   If sPath <> sSlash Then
      List1.AddItem sRootDots
   End If
   
  'The search parameters .. here we'll list
  'all file types. Since GetFTPDirectory takes
  'care of qualifying the path, no terminating
  'slash is required.
   sPath = sPath & "*.*"
      
  'Conation handles used by the FtpFindFirstFile
  'API go out of scope once the all files are
  'listed, therefore it can not be reused.
  'This restriction is handled by obtaining
  'a fresh connection handle each time a call
  'to FtpFindFirstFile is required, and releasing
  'it once finished.
   hFindConnect = GetInternetConnectHandle()
   
  'If a good connection handle ...
   If hFindConnect Then
   
     '..obtain the handle to the files with
     'the FtpFindFirstFile API. Obtaining the
     'directory contents is essentially similar
     'to using the Win32 file system APIs
     'FindFirstFile and FindNextFile, with the
     'sole exception that there is no FtpFindNextFile
     'API. Instead, successive calls are made
     'to InternetFindNextFile. The data returned
     'is in the familiar WIN32_FIND_DATA structure.
      hFind = FtpFindFirstFile(hFindConnect, _
                               sPath, WFD, _
                               INTERNET_FLAG_RELOAD Or _
                               INTERNET_FLAG_NO_CACHE_WRITE, 0&)
   
        'If a valid find handle returned,
        'loop through the directory listing
        'the contents. If the attributes of
        'the returned string indicate a folder,
        'append a slash to make it both visually
        'stand out in the list, and identifiable
        'in the list double-click routine for
        'navigation.
        '
        'hFile will be 0 if the navigated-to
        'folder is empty.
         If hFind Then

               'List1.AddItem ".."
               
            Do
            
               tmp = StripNull(WFD.cFileName)
                              
               If Len(tmp) Then
                  If WFD.dwFileAttributes And vbDirectory Then
                        List1.AddItem tmp & sSlash
                  Else: List1.AddItem tmp
                  End If
               End If
               
            
           'continue while valid
            Loop While InternetFindNextFile(hFind, WFD)
      
         End If 'If hFind

   End If  'If hFindConnect
   
  'clean up by closing the handles used in this routine
   Call InternetCloseHandle(hFind)
   Call InternetCloseHandle(hFindConnect)

   Screen.MousePointer = 0
   
End Sub


Private Function GetInternetConnectHandle() As Long

   Dim sServerName As String
   Dim tmp As Long

  'GetInternetConnectHandle obtains a new
  'handle expressly for use with the
  'FtpFindFirstFile and APIs.
  '
  'Care must be taken to close only the handle
  'returned by this function once the listing
  'of the directory has been obtained.
  '
  'A temporary variable is used here
  'to reduce line length
   If hInternet Then
   
     'Pass the same server as with other
     'calls, along with the requisite username
     'and password. The Microsoft FTP site
     'allows anonymous login, so the username
     'is 'anonymous' and the password is the
     'user's email address.
      sServerName = [COLOR="red"]SERVERNAME OR ADDRESS[/COLOR]

      tmp = InternetConnect(hInternet, _
                            sServerName, _
                            INTERNET_DEFAULT_FTP_PORT, _
                            sFtpUserName, _
                            sFtpPassword, _
                            INTERNET_SERVICE_FTP, _
                            INTERNET_FLAG_EXISTING_CONNECT Or _
                            INTERNET_FLAG_PASSIVE, _
                            &H0)
                                                 
   End If
  
  'return the connection handle
   GetInternetConnectHandle = tmp
      
End Function


Continued on the next post....
 
Last edited:

ajetrumpet

Banned
Local time
Yesterday, 22:24
Joined
Jun 22, 2007
Messages
5,638
The module that makes everything run:
Code:
'THIS MODULE IS NOT A SOURCE MODULE AND CONTAINS CODE FROM WEBSITES

Option Explicit

Public sFtpUserName As String
Public sFtpPassword As String
Public sFtpHostName As String
Public RemoteDir As String


Public Const MAX_PATH  As Long = 260
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20

'use registry configuration
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
'direct to net
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
'via named proxy
Public Const INTERNET_OPEN_TYPE_PROXY = 3
'prevent using java/script/INS
Public Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
'used for FTP connections
Public Const INTERNET_FLAG_PASSIVE = &H8000000
Public Const INTERNET_FLAG_RELOAD = &H80000000

'additional cache flags
'don't write this item to the cache
Public Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Public Const INTERNET_FLAG_DONT_CACHE = INTERNET_FLAG_NO_CACHE_WRITE
'make this item persistent in cache
Public Const INTERNET_FLAG_MAKE_PERSISTENT = &H2000000
'use offline semantics
Public Const INTERNET_FLAG_FROM_CACHE = &H1000000
Public Const INTERNET_FLAG_OFFLINE = INTERNET_FLAG_FROM_CACHE

'additional flags
'use PCT/SSL if applicable (HTTP)
Public Const INTERNET_FLAG_SECURE = &H800000
'use keep-alive semantics
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
'don't handle redirections automatically
Public Const INTERNET_FLAG_NO_AUTO_REDIRECT = &H200000
'do background read prefetch
Public Const INTERNET_FLAG_READ_PREFETCH = &H100000
'no automatic cookie handling
Public Const INTERNET_FLAG_NO_COOKIES = &H80000
'no automatic authentication handling
Public Const INTERNET_FLAG_NO_AUTH = &H40000
'return cache file if net request fails
Public Const INTERNET_FLAG_CACHE_IF_NET_FAIL = &H10000
'return cache file if net request fails
Public Const INTERNET_DEFAULT_FTP_PORT = 21
'   "     "  gopher "
Public Const INTERNET_DEFAULT_GOPHER_PORT = 70
'   "     "  HTTP   "
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
'   "     "  HTTPS  "
Public Const INTERNET_DEFAULT_HTTPS_PORT = 443
'default for SOCKS firewall servers.
Public Const INTERNET_DEFAULT_SOCKS_PORT = 1080
'FTP: use existing InternetConnect handle for server if possible
Public Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3

'transfer flags
Public Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const FTP_TRANSFER_TYPE_BINARY = &H2
Public Const INTERNET_FLAG_TRANSFER_ASCII = FTP_TRANSFER_TYPE_ASCII
Public Const INTERNET_FLAG_TRANSFER_BINARY = FTP_TRANSFER_TYPE_BINARY
Public Const FTP_TRANSFER_TYPE_MASK = (FTP_TRANSFER_TYPE_ASCII Or _
                                       FTP_TRANSFER_TYPE_BINARY)

'internet error flags
Public Const INTERNET_ERROR_BASE = 12000
Public Const ERROR_INTERNET_OUT_OF_HANDLES = (INTERNET_ERROR_BASE + 1)
Public Const ERROR_INTERNET_TIMEOUT = (INTERNET_ERROR_BASE + 2)
Public Const ERROR_INTERNET_EXTENDED_ERROR = (INTERNET_ERROR_BASE + 3)
Public Const ERROR_INTERNET_INTERNAL_ERROR = (INTERNET_ERROR_BASE + 4)
Public Const ERROR_INTERNET_INVALID_URL = (INTERNET_ERROR_BASE + 5)
Public Const ERROR_INTERNET_UNRECOGNIZED_SCHEME = (INTERNET_ERROR_BASE + 6)
Public Const ERROR_INTERNET_NAME_NOT_RESOLVED = (INTERNET_ERROR_BASE + 7)
Public Const ERROR_INTERNET_PROTOCOL_NOT_FOUND = (INTERNET_ERROR_BASE + 8)
Public Const ERROR_INTERNET_INVALID_OPTION = (INTERNET_ERROR_BASE + 9)
Public Const ERROR_INTERNET_BAD_OPTION_LENGTH = (INTERNET_ERROR_BASE + 10)
Public Const ERROR_INTERNET_OPTION_NOT_SETTABLE = (INTERNET_ERROR_BASE + 11)
Public Const ERROR_INTERNET_SHUTDOWN = (INTERNET_ERROR_BASE + 12)
Public Const ERROR_INTERNET_INCORRECT_USER_NAME = (INTERNET_ERROR_BASE + 13)
Public Const ERROR_INTERNET_INCORRECT_PASSWORD = (INTERNET_ERROR_BASE + 14)
Public Const ERROR_INTERNET_LOGIN_FAILURE = (INTERNET_ERROR_BASE + 15)
Public Const ERROR_INTERNET_INVALID_OPERATION = (INTERNET_ERROR_BASE + 16)
Public Const ERROR_INTERNET_OPERATION_CANCELLED = (INTERNET_ERROR_BASE + 17)
Public Const ERROR_INTERNET_INCORRECT_HANDLE_TYPE = (INTERNET_ERROR_BASE + 18)
Public Const ERROR_INTERNET_INCORRECT_HANDLE_STATE = (INTERNET_ERROR_BASE + 19)
Public Const ERROR_INTERNET_NOT_PROXY_REQUEST = (INTERNET_ERROR_BASE + 20)
Public Const ERROR_INTERNET_REGISTRY_VALUE_NOT_FOUND = (INTERNET_ERROR_BASE + 21)
Public Const ERROR_INTERNET_BAD_REGISTRY_PARAMETER = (INTERNET_ERROR_BASE + 22)
Public Const ERROR_INTERNET_NO_DIRECT_ACCESS = (INTERNET_ERROR_BASE + 23)
Public Const ERROR_INTERNET_NO_CONTEXT = (INTERNET_ERROR_BASE + 24)
Public Const ERROR_INTERNET_NO_CALLBACK = (INTERNET_ERROR_BASE + 25)
Public Const ERROR_INTERNET_REQUEST_PENDING = (INTERNET_ERROR_BASE + 26)
Public Const ERROR_INTERNET_INCORRECT_FORMAT = (INTERNET_ERROR_BASE + 27)
Public Const ERROR_INTERNET_ITEM_NOT_FOUND = (INTERNET_ERROR_BASE + 28)
Public Const ERROR_INTERNET_CANNOT_CONNECT = (INTERNET_ERROR_BASE + 29)
Public Const ERROR_INTERNET_CONNECTION_ABORTED = (INTERNET_ERROR_BASE + 30)
Public Const ERROR_INTERNET_CONNECTION_RESET = (INTERNET_ERROR_BASE + 31)
Public Const ERROR_INTERNET_FORCE_RETRY = (INTERNET_ERROR_BASE + 32)
Public Const ERROR_INTERNET_INVALID_PROXY_REQUEST = (INTERNET_ERROR_BASE + 33)
Public Const ERROR_INTERNET_NEED_UI = (INTERNET_ERROR_BASE + 34)
Public Const ERROR_INTERNET_HANDLE_EXISTS = (INTERNET_ERROR_BASE + 36)
Public Const ERROR_INTERNET_SEC_CERT_DATE_INVALID = (INTERNET_ERROR_BASE + 37)
Public Const ERROR_INTERNET_SEC_CERT_CN_INVALID = (INTERNET_ERROR_BASE + 38)
Public Const ERROR_INTERNET_HTTP_TO_HTTPS_ON_REDIR = (INTERNET_ERROR_BASE + 39)
Public Const ERROR_INTERNET_HTTPS_TO_HTTP_ON_REDIR = (INTERNET_ERROR_BASE + 40)
Public Const ERROR_INTERNET_MIXED_SECURITY = (INTERNET_ERROR_BASE + 41)
Public Const ERROR_INTERNET_CHG_POST_IS_NON_SECURE = (INTERNET_ERROR_BASE + 42)
Public Const ERROR_INTERNET_POST_IS_NON_SECURE = (INTERNET_ERROR_BASE + 43)
Public Const ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED = (INTERNET_ERROR_BASE + 44)
Public Const ERROR_INTERNET_INVALID_CA = (INTERNET_ERROR_BASE + 45)
Public Const ERROR_INTERNET_CLIENT_AUTH_NOT_SETUP = (INTERNET_ERROR_BASE + 46)
Public Const ERROR_INTERNET_ASYNC_THREAD_FAILED = (INTERNET_ERROR_BASE + 47)
Public Const ERROR_INTERNET_REDIRECT_SCHEME_CHANGE = (INTERNET_ERROR_BASE + 48)
Public Const ERROR_INTERNET_DIALOG_PENDING = (INTERNET_ERROR_BASE + 49)
Public Const ERROR_INTERNET_RETRY_DIALOG = (INTERNET_ERROR_BASE + 50)
Public Const ERROR_INTERNET_HTTPS_HTTP_SUBMIT_REDIR = (INTERNET_ERROR_BASE + 52)
Public Const ERROR_INTERNET_INSERT_CD_ROM = (INTERNET_ERROR_BASE + 53)
Public Const ERROR_INTERNET_FORTEZZA_LOGIN_NEEDED = (INTERNET_ERROR_BASE + 54)
Public Const ERROR_INTERNET_SEC_CERT_ERRORS = (INTERNET_ERROR_BASE + 55)
Public Const ERROR_INTERNET_SEC_CERT_NO_REV = (INTERNET_ERROR_BASE + 56)
Public Const ERROR_INTERNET_SEC_CERT_REV_FAILED = (INTERNET_ERROR_BASE + 57)

'FTP API errors
Public Const ERROR_FTP_TRANSFER_IN_PROGRESS = (INTERNET_ERROR_BASE + 110)
Public Const ERROR_FTP_DROPPED = (INTERNET_ERROR_BASE + 111)
Public Const ERROR_FTP_NO_PASSIVE_MODE = (INTERNET_ERROR_BASE + 112)

'gopher API errors
Public Const ERROR_GOPHER_PROTOCOL_ERROR = (INTERNET_ERROR_BASE + 130)
Public Const ERROR_GOPHER_NOT_FILE = (INTERNET_ERROR_BASE + 131)
Public Const ERROR_GOPHER_DATA_ERROR = (INTERNET_ERROR_BASE + 132)
Public Const ERROR_GOPHER_END_OF_DATA = (INTERNET_ERROR_BASE + 133)
Public Const ERROR_GOPHER_INVALID_LOCATOR = (INTERNET_ERROR_BASE + 134)
Public Const ERROR_GOPHER_INCORRECT_LOCATOR_TYPE = (INTERNET_ERROR_BASE + 135)
Public Const ERROR_GOPHER_NOT_GOPHER_PLUS = (INTERNET_ERROR_BASE + 136)
Public Const ERROR_GOPHER_ATTRIBUTE_NOT_FOUND = (INTERNET_ERROR_BASE + 137)
Public Const ERROR_GOPHER_UNKNOWN_LOCATOR = (INTERNET_ERROR_BASE + 138)

'HTTP API errors
Public Const ERROR_HTTP_HEADER_NOT_FOUND = (INTERNET_ERROR_BASE + 150)
Public Const ERROR_HTTP_DOWNLEVEL_SERVER = (INTERNET_ERROR_BASE + 151)
Public Const ERROR_HTTP_INVALID_SERVER_RESPONSE = (INTERNET_ERROR_BASE + 152)
Public Const ERROR_HTTP_INVALID_HEADER = (INTERNET_ERROR_BASE + 153)
Public Const ERROR_HTTP_INVALID_QUERY_REQUEST = (INTERNET_ERROR_BASE + 154)
Public Const ERROR_HTTP_HEADER_ALREADY_EXISTS = (INTERNET_ERROR_BASE + 155)
Public Const ERROR_HTTP_REDIRECT_FAILED = (INTERNET_ERROR_BASE + 156)
Public Const ERROR_HTTP_NOT_REDIRECTED = (INTERNET_ERROR_BASE + 160)
Public Const ERROR_HTTP_COOKIE_NEEDS_CONFIRMATION = (INTERNET_ERROR_BASE + 161)
Public Const ERROR_HTTP_COOKIE_DECLINED = (INTERNET_ERROR_BASE + 162)
Public Const ERROR_HTTP_REDIRECT_NEEDS_CONFIRMATION = (INTERNET_ERROR_BASE + 168)

'additional Internet API error codes
Public Const ERROR_INTERNET_SECURITY_CHANNEL_ERROR = (INTERNET_ERROR_BASE + 157)
Public Const ERROR_INTERNET_UNABLE_TO_CACHE_FILE = (INTERNET_ERROR_BASE + 158)
Public Const ERROR_INTERNET_TCPIP_NOT_INSTALLED = (INTERNET_ERROR_BASE + 159)
Public Const ERROR_INTERNET_DISCONNECTED = (INTERNET_ERROR_BASE + 163)
Public Const ERROR_INTERNET_SERVER_UNREACHABLE = (INTERNET_ERROR_BASE + 164)
Public Const ERROR_INTERNET_PROXY_SERVER_UNREACHABLE = (INTERNET_ERROR_BASE + 165)
Public Const ERROR_INTERNET_BAD_AUTO_PROXY_SCRIPT = (INTERNET_ERROR_BASE + 166)
Public Const ERROR_INTERNET_UNABLE_TO_DOWNLOAD_SCRIPT = (INTERNET_ERROR_BASE + 167)
Public Const ERROR_INTERNET_SEC_INVALID_CERT = (INTERNET_ERROR_BASE + 169)
Public Const ERROR_INTERNET_SEC_CERT_REVOKED = (INTERNET_ERROR_BASE + 170)

'InternetAutodial specific errors
Public Const ERROR_INTERNET_FAILED_DUETOSECURITYCHECK = (INTERNET_ERROR_BASE + 171)
Public Const ERROR_INTERNET_NOT_INITIALIZED = (INTERNET_ERROR_BASE + 172)
Public Const ERROR_INTERNET_NEED_MSN_SSPI_PKG = (INTERNET_ERROR_BASE + 173)
Public Const ERROR_INTERNET_LOGIN_FAILURE_DISPLAY_ENTITY_BODY = (INTERNET_ERROR_BASE + 174)
Public Const INTERNET_ERROR_LAST = ERROR_INTERNET_FAILED_DUETOSECURITYCHECK

Public Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type


Public Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Public Declare Function InternetOpen Lib "wininet" _
   Alias "InternetOpenA" _
  (ByVal lpszAgent As String, _
   ByVal dwAccessType As Long, _
   ByVal lpszProxyName As String, _
   ByVal lpszProxyBypass As String, _
   ByVal dwflags As Long) As Long

Public Declare Function InternetCloseHandle Lib "wininet" _
   (ByVal hEnumHandle As Long) As Long

Public Declare Function InternetConnect Lib "wininet" _
   Alias "InternetConnectA" _
  (ByVal hInternet As Long, _
   ByVal lpszServerName As String, _
   ByVal nServerPort As Long, _
   ByVal lpszUserName As String, _
   ByVal lpszPassword As String, _
   ByVal dwService As Long, _
   ByVal dwflags As Long, _
   ByVal dwContext As Long) As Long

Public Declare Function FtpFindFirstFile Lib "wininet" _
   Alias "FtpFindFirstFileA" _
  (ByVal hConnect As Long, _
   ByVal lpszSearchFile As String, _
   lpFindFileData As Any, _
   ByVal dwflags As Long, _
   ByVal dwContext As Long) As Long

Public Declare Function InternetFindNextFile Lib "wininet" _
   Alias "InternetFindNextFileA" _
  (ByVal hFind As Long, _
   lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function InternetGetLastResponseInfo Lib "wininet" _
   Alias "InternetGetLastResponseInfoA" _
  (lpdwError As Long, _
   ByVal lpszBuffer As String, _
    lpdwBufferLength As Long) As Long
   
Public Declare Function FtpGetCurrentDirectory Lib "wininet" _
   Alias "FtpGetCurrentDirectoryA" _
  (ByVal hConnect As Long, _
   ByVal lpszCurrentDirectory As String, _
    lpdwCurrentDirectory As Long) As Long

Public Declare Function FtpSetCurrentDirectory Lib "wininet" _
   Alias "FtpSetCurrentDirectoryA" _
  (ByVal hConnect As Long, _
   ByVal lpszDirectory As String) As Long

Public Declare Function FtpGetFile Lib "wininet" _
   Alias "FtpGetFileA" _
  (ByVal hConnect As Long, _
   ByVal lpszRemoteFile As String, _
   ByVal lpszNewFile As String, _
   ByVal fFailIfExists As Long, _
   ByVal dwFlagsAndAttributes As Long, _
   ByVal dwflags As Long, _
   ByVal dwContext As Long) As Long
   
Public Function GetErr(ByVal lErrorCode As Long) As String

   Dim sBuffer As String
   Dim nBuffer As Long

   Select Case lErrorCode
      Case 12001: GetErr = _
         "No more handles could be generated at this time"
      Case 12002: GetErr = _
         "The request has timed out."
      Case 12003:
         'extended error. Retrieve the details using
         'the InternetGetLastResponseInfo API.
         
         sBuffer = Space$(MAX_PATH)
         nBuffer = Len(sBuffer)
         
         If InternetGetLastResponseInfo(lErrorCode, _
                                        sBuffer, _
                                        nBuffer) Then
            GetErr = StripNull(sBuffer)
         Else
            GetErr = "Extended error returned from server."
         End If
         
      Case 12004: GetErr = _
         "An internal error has occurred."
      Case 12005: GetErr = _
         "URL is invalid."
      Case 12006: GetErr = _
         "URL scheme could not be recognized, or is not supported."
      Case 12007: GetErr = _
         "Server name could not be resolved."
      Case 12008: GetErr = _
         "Requested protocol could not be located."
      Case 12009: GetErr = _
         "Request to InternetQueryOption or InternetSetOption" & _
         " specified an invalid option value."
      Case 12010: GetErr = _
         "Length of an option supplied to InternetQueryOption or" & _
         " InternetSetOption is incorrect for the type of" & _
         " option specified."
      Case 12011: GetErr = _
         "Request option can not be set, only queried. "
      Case 12012: GetErr = _
         "Win32 Internet support is being shutdown or unloaded."
      Case 12013: GetErr = _
         "Request to connect and login to an FTP server could not" & _
         " be completed because the supplied username/password is incorrect."
      Case 12014: GetErr = _
         "Request to connect and login to an FTP server could not" & _
         " be completed because the supplied username/password is incorrect. "
      Case 12015: GetErr = _
         "Request to connect to and login to an FTP server failed."
      Case 12016: GetErr = _
         "Requested operation is invalid. "
      Case 12017: GetErr = _
         "Operation was canceled, usually because the handle on" & _
         " which the request was operating was closed before the" & _
         " operation completed."
      Case 12018: GetErr = _
         "Type of handle supplied is incorrect for this operation."
      Case 12019: GetErr = _
         "Requested operation can not be carried out because the" & _
         " handle supplied is not in the correct state."
      Case 12020: GetErr = _
         "Request can not be made via a proxy."
      Case 12021: GetErr = _
         "Required registry value could not be located. "
      Case 12022: GetErr = _
         "Required registry value was located but is an incorrect" & _
         " type or has an invalid value."
      Case 12023: GetErr = _
         "Direct network access cannot be made at this time. "
      Case 12024: GetErr = _
         "Asynchronous request could not be made because a zero" & _
         " context value was supplied."
      Case 12025: GetErr = _
         "Asynchronous request could not be made because a" & _
         " callback function has not been set."
      Case 12026: GetErr = _
         "Required operation could not be completed because" & _
         " one or more requests are pending."
      Case 12027: GetErr = _
         "Format of the request is invalid."
      Case 12028: GetErr = _
         "Requested item could not be located."
      Case 12029: GetErr = _
         "Attempt to connect to the server failed."
      Case 12030: GetErr = _
         "Connection with the server has been terminated."
      Case 12031: GetErr = _
         "Connection with the server has been reset."
      Case 12036: GetErr = _
         "Request failed because the handle already exists."
      Case Else: GetErr = _
         "Error details not available."
   End Select

End Function

Function StripNull(item As String)

   'Return a string without the chr$(0) terminator.
    Dim pos As Integer
    pos = InStr(item, Chr$(0))
    
    If pos Then
       StripNull = Left$(item, pos - 1)
    Else
       StripNull = item
    End If

End Function


Another module that's needed:
Code:
Option Explicit

Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type

Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwflags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Private Type OVERLAPPED
    internal As Long
    internalHigh As Long
    offset As Long
    OffsetHigh As Long
    hEvent As Long
End Type

Private Const STARTF_USESHOWWINDOW = &H1
Private Const STARTF_USESTDHANDLES = &H100
Private Const SW_HIDE = 0
Private Const SW_SHOWDEFAULT As Long = 10

Private Const EM_SETSEL = &HB1
Private Const EM_REPLACESEL = &HC2
Public Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetThreadDesktop Lib "User32.dll" (ByVal dwThread As Long) As Long
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByRef lpOverlapped As Any) As Long

Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Const WAIT_TIMEOUT As Long = 258&

Public Sub ExecWait(cmdLine As String, Optional ByVal WindowShowMode As Long = 10)
    Dim i%, t$
    Dim pa As SECURITY_ATTRIBUTES
    Dim pra As SECURITY_ATTRIBUTES
    Dim tra As SECURITY_ATTRIBUTES
    Dim pi As PROCESS_INFORMATION
    Dim sui As STARTUPINFO
    Dim hRead As Long
    Dim hWrite As Long
    Dim bRead As Long
   
    Dim lpBuffer As String, wholestr As String
 
    
 
        sui.cb = Len(sui)
        GetStartupInfo sui
        sui.dwflags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
        sui.wShowWindow = WindowShowMode
        If CreateProcess(vbNullString, cmdLine, pra, tra, 1, 0, ByVal 0&, vbNullString, sui, pi) <> 0 Then
            'SetWindowText objTarget.hwnd, ""
            'If Not GetThreadDesktop(pi.hThread) = 0 Then
            'insert waitforsingleobject loop here...
            Dim rtret As Long
            Do
                rtret = WaitForSingleObject(pi.hProcess, 100)
                If rtret <> WAIT_TIMEOUT Then
                    Exit Do
                End If
                DoEvents
            
            Loop
           
        End If

End Sub
 
Last edited:

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 04:24
Joined
Sep 12, 2006
Messages
15,653
what is error 430

i would try ftp in cmd window, or try filezilla or something similar, to make sure you can connect to the ftp server

i find with my own connection that if i am using a wireless connection to my router , then ftp works fine - but if i am using a wired connection, then the firewalls block the traffic - and I haven't been able to resolve this....

so maybe its a windows problem, and not an application problem.
 

Users who are viewing this thread

Top Bottom