64bit版のExcel VBAで動作確認しています
ご利用は、自己責任で
あくまでも、
学習・動作検証用のサンプルです
ご利用は、自己責任で
あくまでも、
学習・動作検証用のサンプルです
Win32API用の宣言
Public Const INTERNET_DEFAULT_FTP_PORT As Long = 21
Public Const INTERNET_SERVICE_FTP As Long = 1
Public Const INTERNET_OPEN_TYPE_PRECONFIG As Long = &H0
Public Const FTP_TRANSFER_TYPE_ASCII As Long = &H1
Public Const FTP_TRANSFER_TYPE_BINARY As Long = &H2
Public Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Public Const INTERNET_CONNECT_FLAG_PASSIVE As Long = &H8000000
#If Win64 Then
Public Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long
Public Declare PtrSafe Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _
ByVal hInternetSession As Long, _
ByVal sServerName As String, _
ByVal nServerPort As Long, _
ByVal sUsername As String, _
ByVal sPassword As String, _
ByVal lService As Long, _
ByVal lFlags As Long, _
ByVal lcontext As Long) As Long
Public Declare PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" ( _
ByVal hConnect As Long, _
ByVal lpszDirectory As String) As Long
Public Declare PtrSafe Function FtpGetFile Lib "wininet.dll" 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 Boolean
Public Declare PtrSafe Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" ( _
ByVal hConnect As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
Public Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" ( _
ByVal hInet As Long) As Integer
#Else
'===========
' 32bit用の宣言を書く
'============
#End If
Win32APIを使う為にDeclare文を標準モジュールに書く。とりあえず動作はしてますが、これで正しいのかどうか不明。
64bit用の宣言しか書いていません。32bitのEXCELの人は、32bit用の宣言の部分を追記してください。
FTP接続情報
'---------------
'FTP接続情報
'---------------
Public Const strFtpServer As String = "ftp.example.com"
Public Const strFtpUser As String = "ftpuser"
Public Const strFtpPasswd As String = "*************"
動画撮影用に作成したので、パスワードとかの情報が見えにくいように、別の標準モジュールに記述した。
FTPでアップロードする
Sub main()
'---------------
'WinInetの初期化
'---------------
hInternetSession = InternetOpen(vbNullString, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&)
If hInternetSession = 0 Then
Debug.Print ("WinInetの初期化:失敗")
Debug.Print (Err.LastDllError)
End
End If
Debug.Print ("WinInetの初期化:成功")
'---------------
'FTPサーバに接続
'---------------
'パッシブモードで接続
hConnect = InternetConnect(hInternetSession, strFtpServer, INTERNET_DEFAULT_FTP_PORT, strFtpUser, strFtpPasswd, INTERNET_SERVICE_FTP, INTERNET_CONNECT_FLAG_PASSIVE, 0&)
If hConnect = 0 Then
Debug.Print ("FTPサーバに接続:失敗")
Debug.Print (Err.LastDllError)
End
End If
Debug.Print ("FTPサーバに接続:成功")
'---------------
'FTP先のフォルダ移動
'---------------
strDir = "/test" 'アップロード先
ret = FtpSetCurrentDirectory(hConnect, strDir)
If ret = 0 Then
Debug.Print ("FTP先のフォルダ移動:失敗")
Debug.Print (Err.LastDllError)
End
End If
Debug.Print ("FTP先のフォルダ移動:成功")
'---------------
'ファイルの転送
'---------------
strLocalFile = "I:\TEMP\doc\23626_information_document.docx"
strUploadFile = "23626_information_document.docx"
ret = FtpPutFile(hConnect, strLocalFile, strUploadFile, FTP_TRANSFER_TYPE_BINARY, 0&)
If ret = 0 Then
Debug.Print ("ファイルの転送:失敗")
Debug.Print (Err.LastDllError)
End
End If
Debug.Print ("ファイルの転送:成功")
'---------------
'終了処理
'---------------
ret = InternetCloseHandle(hConnect)
ret = InternetCloseHandle(hInternetSession)
End Sub
FTP接続にはパッシブモード(PASSIVE)を使用しないと、接続には成功しても、ファイルの転送で失敗する可能性があります
FTP接続時のカレントディレクトリーがレンタルサーバーによって違うので気を付けてください。まずは「/」で試して成功することを確認したうえで、試行錯誤するとよいかも。12003になる場合は、フォルダ(ディレクトリ)が存在しない以外にもあります。フォルダ(ディレクトリ指定)は、FTP接続時のカレントディレクトリからの相対になるようなので注意が必要です。
日本語ファイル名とかは避けたほうが良いかも。
動画での説明
少しずつ確認しながら作成すると、どこがダメなのか分かりよいと思います。
動作確認は、XREAとスターサーバーで確認しました。
XREA
・無料から使える高機能・高品質レンタルサーバー | XREA(エクスリア)
最近、簡単な動作確認用に使っている。
スポンサーリンク
コメントを残す