ftpでアップロードが出来ない

コレまで使っていた「basp21」がwin10で動かないため、
basp21を諦め、サイトで探したところ、
以下のようなサンプルを見付けやってみました。

ステップで追っていくと、
接続、ログインまではスンナリ行けていますが、
いざファイルのアップのところで、タイムアウトしてしまいます。

何処が悪いのか分かりません。
原因が知りたいので、考えられることを教えて下さい。
タイムアウトは３０秒くらいかと思います。
ログインまではアッという間なので、
時間が掛かっているのではなく、
何かが不味いと思っています。

宜しくお願いします。

環境は、
win10home、excel2003、です。

使用（D/Lした）excelvbaです。******************************

Option Explicit
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
Sub FTP_Upload()
'FTPアップロードの例

Const cstrServer As String = "netftp.asahi-net.or.jp" 'FTPサーバー名
Const cstrUserName As String = "xxxxxxx" 'アカウント名
Const cstrPassword As String = "yyyyyyyy" 'パスワード

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 = "ssss/tttt/uuuu"
'アップロード元ファイル名を設定
strFrom = ThisWorkbook.Path & "\wk8.log"
'アップロード先ファイル名を設定
strTo = "\wk8.log"

'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_ASCII, 0&)
If lngRet <> 0 Then
'成功したとき
MsgBox "ファイルのアップロードに成功しました！", vbOKOnly + vbInformation
End If
End If
'FTPをクローズ
InternetCloseHandle lngInet
End If

End Sub

No.1 ベストアンサー 回答者： bx2 回答日時： 2021/03/17 16:49

パッシブモードで接続していないからでしょう。

FTP接続には、アクティブモードとパッシブモードの2つがあります。

INTERNET_FLAG_PASSIVE を使うようです。

この回答へのお礼

早速有り難うございました。
まさにご指摘どおりでした。
調べて設定したところアッサリ解決してしまいました。
お世話になりました。

お礼日時：2021/03/17 21:06

No.2 回答者： goold-man 回答日時： 2021/03/17 20:01

サーバー側の設定を確認。

ディレクトリに書き込み権限が設定されているか確認。
FTPサーバー側の設定でアップロードが制限されている場合もあります。

この回答へのお礼

有り難うございました。

お礼日時：2021/03/17 21:07