#409 FTPでファイルをアップロードする方法 VBA、API

WinInet.DLLのAPI関数を使うと、ローカルのファイルをFTPサーバー上にアップロードすることができます。

それにはまず、標準モジュールに次のようなAPIの宣言を記述します。

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
Private Declare Function FtpPutFileB _
          Lib "WinInet.DLL" Alias "FtpPutFileA" _
          (ByVal hFtpSession As Long, ByRef lpszLocalFile As Byte, _
           ByRef lpszNewRemoteFile As Byte, 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


次のサンプルプロシージャでは、ローカルの「c:\image.gif」ファイルを、FTPサーバー上の「homepage/images/」ディレクトリに「image.gif」としてアップロードしています。
なお、FTPサーバー名やアカウント名は適宜書き換えて実行してください。

Sub FTP_Upload()
'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 abytFrom() As Byte
  Dim abytTo() As Byte
  Dim lngInet As Long
  Dim lngFTP As Long
  Dim lngRet As Long

  'アップロード先ディレクトリを設定
  strDir = "homepage/images/"
  'アップロード元ファイル名を設定
  strFrom = "c:\image.gif"
  'アップロード先ファイル名を設定
  strTo = "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
      '成功したとき
      'アップロード先ディレクトリへ移動
      FtpSetCurrentDirectoryS lngFTP, strDir
      'ファイル名をUnicodeから変換
      abytFrom = StrConv((strFrom & vbNullChar), vbFromUnicode)
      abytTo = StrConv((strTo & vbNullChar), vbFromUnicode)
      'ファイルをバイナリモードでアップロード
      '(ASCIIモードの場合はTRANSFER_TYPE_ASCIIを指定)
      lngRet = FtpPutFileB(lngFTP, abytFrom(0), abytTo(0), _
                            FTP_TRANSFER_TYPE_BINARY, 0&)
      If lngRet <> 0 Then
        '成功したとき
        MsgBox "ファイルのアップロードに成功しました!", vbOKOnly + vbInformation
      End If
    End If
    'FTPをクローズ
    InternetCloseHandle lngInet
  End If

End Sub

| Index | Prev | Next |

この情報は参考になりましたか?、問題は解決しましたか?、もしまだなら......
T'sWareのワンポイトテクニカルアドバイスをご利用ください。3000円/件〜でご支援します。
スタンドアロンからSQL Server対応まで、オーダーメイドのシステムを短納期・安価でお届けします
 

Copyright © T'sWare All rights reserved