FTP関連

Declare Function InternetOpen 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
Declare Function InternetConnect Lib "WinInet.DLL" Alias "InternetConnectA" (ByVal hInternet 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
Declare Function FtpPutFile Lib "WinInet.DLL" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, _
            ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Declare Function FtpGetFile Lib "WinInet.DLL" Alias "FtpGetFileA" (ByVal hConnect As Long, ByVal lpszRemoteFile As String, _
            ByVal lpszNewLocalFile As String, ByVal fFailIfExists As Long, _
            ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean

Declare Function InternetCloseHandle Lib "WinInet.DLL" (ByVal hInternet As Long) As Integer
Const FTP_TRANSFER_TYPE_ASCII As Long = &H1 'アスキーモード
Const FTP_TRANSFER_TYPE_BINARY As Long = &H2 'バイナリモード
Const server = "XXXXXXX" 'ホスト名
Const user = "XXXXXXXX" 'ユーザー名
Const passwd = "XXXXXXX" 'パスワード
Const serverFile = "XXXXXXXX"  'サーバファイル名

'使い方のサンプル

Public Sub Main()
    Dim lngEnter As Long

    'ダウンロード先のファイル名の指定

    lngEnter = Ftp_DownLoad("C:\Users\Owner\AppData\Roaming\Microsoft\Excel\XLSTART\AddInsMainDl.xlsb")
    If lngEnter <> 0 Then
       
        Exit Sub
    End If
   
    lngEnter = Ftp_Upload("C:\Users\Owner\AppData\Roaming\Microsoft\Excel\XLSTART\AddInsMain.xlsb")
    If lngEnter <> 0 Then
       
        Exit Sub
    End If
End Sub

'引数：アップロードするファイル名
Public Function Ftp_Upload(ByVal LocalFile As String) As Long

    Dim hOpen As Long
    Dim hConnection As Long
    Dim result As Long
    Do
        hOpen = InternetOpen(server, 1, vbNullString, vbNullString, 0)
        If hOpen = 0 Then
            'MsgBox "オープンエラー：" & Err.LastDllError
            Ftp_Upload = Err.LastDllError
            Exit Do
        End If
        hConnection = InternetConnect(hOpen, server, 0, user, passwd, 1, 0, 0)
        If hConnection = 0 Then
            'MsgBox "接続エラー：" & Err.LastDllError
            Ftp_Upload = Err.LastDllError
            Exit Do
        End If
        If FtpPutFile(hConnection, LocalFile, serverFile, FTP_TRANSFER_TYPE_BINARY, 0) = 0 Then
            'MsgBox "転送エラー：" & Err.LastDllError
            Ftp_Upload = Err.LastDllError
            Exit Do
        End If
    Loop Until True
    If (hConnection <> 0) Then InternetCloseHandle hConnection
    If (hOpen <> 0) Then InternetCloseHandle hOpen
    'MsgBox "成功"
    Ftp_Upload = 0
End Function

'引数：ダウンロードするファイル名
Public Function Ftp_DownLoad(ByVal LocalFile As String) As Long
    Dim hOpen As Long
    Dim hConnection As Long
    Dim result As Long
    Do
        hOpen = InternetOpen(server, 1, vbNullString, vbNullString, 0)
        If hOpen = 0 Then
            'MsgBox "オープンエラー：" & Err.LastDllError
            Ftp_DownLoad = Err.LastDllError
            Exit Do
        End If
        hConnection = InternetConnect(hOpen, server, 0, user, passwd, 1, 0, 0)
        If hConnection = 0 Then
            'MsgBox "接続エラー：" & Err.LastDllError
            Ftp_DownLoad = Err.LastDllError
            Exit Do
        End If
       

        If FtpGetFile(hConnection, serverFile, LocalFile, 1&, FILE_ATTRIBUTE_NORMAL, FTP_TRANSFER_TYPE_BINARY, 0&) = 0 Then
            'MsgBox "転送エラー：" & Err.LastDllError
            Ftp_DownLoad = Err.LastDllError
            Exit Do
        End If
    Loop Until True
    If (hConnection <> 0) Then InternetCloseHandle hConnection
    If (hOpen <> 0) Then InternetCloseHandle hOpen
    'MsgBox "成功"
    Ftp_DownLoad = 0

End Function