Private Declare Function InternetOpenS _
          Lib "WinInet.DLL" Alias "InternetOpenA" _
          (ByVal lpszAgent As String, ByVal dwAccessType As Long, _
           ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, _
           ByVal dwFlags As Long) As Long
Private Declare Function InternetConnectS Lib _
          "WinInet.DLL" Alias "InternetConnectA" _
          (ByVal hInternetSession As Long, ByVal lpszServerName As String, _
           ByVal nServerPort As Integer, 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 FtpSetCurrentDirectoryS _
          Lib "WinInet.DLL" Alias "FtpSetCurrentDirectoryA" _
          (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Long
Public Declare Function FtpGetFileS _
          Lib "WinInet.DLL" Alias "FtpGetFileA" _
          (ByVal hFtpSession 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
Private Declare Function InternetCloseHandle _
          Lib "WinInet.DLL" _
          (ByVal hInet As Long) As Long

Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_SERVICE_FTP = 1&
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80

Sub FTP_Download()
'FTPダウンロードの例

  Const cstrServer As String = "******.com"   'FTPサーバー名
  Const cstrUserName As String = "******"     'アカウント名
  Const cstrPassword As String = "******"     'パスワード

  Dim strDir As String
  Dim strFrom As String
  Dim strTo As String
  Dim lngInet As Long
  Dim lngFTP As Long
  Dim lngRet As Long

  'ダウンロード元ディレクトリを設定
  strDir = "homepage/images/"
  'ダウンロード元ファイル名を設定
  strFrom = "image.gif"
  'ダウンロード先ファイル名を設定
  strTo = "c:\image.gif"

  'FTPをオープン
  lngInet = InternetOpenS(vbNullString, INTERNET_OPEN_TYPE_PRECONFIG, _
                          vbNullString, vbNullString, 0&)
  If lngInet <> 0 Then
    '成功したらFTPサーバーに接続
    lngFTP = InternetConnectS(lngInet, cstrServer, _
                              INTERNET_DEFAULT_FTP_PORT, _
                              cstrUserName, cstrPassword, _
                              INTERNET_SERVICE_FTP, 0&, 0&)
    If lngFTP <> 0 Then
      '成功したとき
      'ダウンロード先ファイルがあったら削除
      If Len(Dir(strTo)) > 0 Then
        Kill strTo
      End If
      'ダウンロード元ディレクトリへ移動
      FtpSetCurrentDirectoryS lngFTP, strDir
      'ファイルをバイナリモードでダウンロード
      '（ASCIIモードの場合はTRANSFER_TYPE_ASCIIを指定）
      lngRet = FtpGetFileS(lngFTP, strFrom, strTo, _
                           1&, FILE_ATTRIBUTE_NORMAL, _
                           FTP_TRANSFER_TYPE_BINARY, 0&)
      If lngRet <> 0 Then
        '成功したとき
        MsgBox "ファイルのダウンロードに成功しました！", vbOKOnly + vbInformation
      End If
    End If
    'FTPをクローズ
    InternetCloseHandle lngInet
  End If

End Sub