FTPでホストのファイル一覧を作成する。

特に「FTP」に詳しいわけではありませんが....
最近では、このサイトの更新で「FTP」を利用しています。 古くは、Windowsパソコンが台頭する以前には、簡単なファイル転送で「FTP」を使用することはありましたが、 Windows環境になってからはエクスプローラ上でネットワークが参照できるような便利さから、しばらく「FTP」から遠ざかっていました。
しかし、このサイトを立ち上げてからはサイトの更新に「FTP」を使います。かと言って、そのためにこのようなマクロが必要なわけではありません。 サイトの更新には「FFFTP」というフリーソフトを使ってみたりしてますが、 「最新があれば上書き」モードで使用すると、最近はハングしてしまいます。どうやらサイト内のファイル数が多すぎる(1,500ファイル以上)のか、配下のフォルダを個々に指定すれば問題ないので、そのようにして利用しています。
そこで、最終的には専用の「FTP」によるサイト更新プログラムを用意しようかな、と思って試してみたのでご紹介することにしました。 利用する方法は、コマンドプロンプトの「FTP」ではなく、「メール送信」でご紹介しているフリーのコンポーネントであるBASP21を使うことにしました。 別途、インストールする必要はありますが、コマンドプロンプトの操作は不要で「直接的」に操作でき、処理終了の判定も不要で、処理結果の受け取りも比較的簡単です。
BASP21」は64ビット版Excelの対応はありません。   このページで紹介している「BASP21」はかなり古くからあるコンポーネントなのですが、 コンポーネント自体に64ビット版の提供がないため、64ビット版Excelでの利用はできません。



このサンプルの機能は、接続先ホストのファイル一覧の取得です。
個人的には、最終的には更新したファイルを自動的にアップロードさせるところまで作成したいのですが、「FTP」をマクロで操作するのも未経験だったので、 とりあえず、接続先ホストのファイル一覧を、「フォルダ内のファイル一覧の取得」のようにフォルダ階層に依存されすに一覧表示させることをやってみることにします。
FTPでホストのファイル一覧を作成する。
(この画像をクリックすると、ダウンロードができます。)
マクロの起動については、特にボタンなどは用意していないので、ツールバーの「ツール」メニューから「マクロ」を選ぶか、Alt+F8でマクロを選択して「TEST_FTP」を起動させて下さい。 起動させると、画面のようなフォームが表示されるので、接続先ホスト(FTPサーバ)の接続情報を入力した上で「処理開始」をクリックして下さい。

この画像は、某プロバイダの「FTP」サイトの一覧を取得したものです。
このような企業や大学などの公開サーバは「anonymous」ユーザーで読み取り専用で利用できます。
FTPでホストのファイル一覧を作成する。
並んでいるのはバイオスなどのアップデート用ファイルなのでしょうか。処理中は、ステータスバーに処理中のホスト側のフォルダ名が表示されるようになっています。 このような形で、一覧がフォルダツリーの表現に合わせて表示されるようになっています。
ファイル情報は、このサンプルでは「GetDir」メソッドで受け取ったものをそのまま表示させていますが、この中の編集(更新日時、サイズ、ファイル名等)はどうやら接続ホストのタイプ(OSFTPプロダクト?)によって異なるようです。 この画像で表示しているものと、例えば当サイトを立ち上げている「ASAHIネット」の更新用FTPサーバの編集内容はすでに全く違います。 自動更新などの「仕掛け」を考える場合は、接続ホストの実際の編集状態を確認するようにして下さい。

本処理では、フリーのコンポーネントであるBASP21を使っているので、 インストールされていない場合は、ダウンロードの上インストールさせてご利用下さい。

今回の処理では、場合によっては数百、数千、あるいはそれ以上のファイル情報を取得することになるかも知れないので、動作を行なう場合は注意を払って下さい。 ソースコードを見て分かるように、これはコードサンプルとして提示しているもので、接続以後は特にエラー処置は行なっていません。 処理開始以降は、Escキーで処理が止められるので、この中断方法も理解しておいて下さい。

では、ソースコードのご紹介です。
モジュールの先頭の方にある定数「cnsTEST」は、「テスト」と「本番」を切り分ける定数です。 この値が「1」の場合は「テストモード」として動作し、イミディエイトウィンドウにデバッグ情報を表示するほか、 実際のファイル一覧も100行を超えた区切りで処理を打ち切るようになっています。

'***************************************************************************************************
'   FTPでファイル一覧を取得する                                     Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'06/01/14(1.00)新規作成
'20/03/02(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Public Const g_cnsTEST As Integer = 1                       ' テストモ-ド
'Public Const g_cnsTEST As Integer = 0                       ' 本番モード(Debug出力なし)
'---------------------------------------------------------------------------------------------------
Private tblPath(1 To 50) As String                          ' フォルダ名表示用テーブル

'***************************************************************************************************
'   ■■■ ワークシート側からの呼び出し処理 ■■■
'***************************************************************************************************
'* 処理名 :TEST_FTP
'* 機能  :FTPでファイル一覧を取得
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2006年01月14日
'* 作成者 :井上 治
'* 更新日 :2020年03月02日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Sub TEST_FTP()
    '-----------------------------------------------------------------------------------------------
    Dim objFTP As Object                                            ' BASP21.FTP
    Dim vntRet As Variant                                           ' 処理結果
    Dim swOpen As Boolean                                           ' 接続判定
    Dim blnResult As Boolean                                        ' フォーム登録結果
    Dim strAddr As String                                           ' 接続先ホストアドレス
    Dim strUser As String                                           ' 接続ユーザー名
    Dim strPass As String                                           ' パスワード
    Dim strRoot As String                                           ' ホスト側ルートフォルダ
    Dim strMSG As String                                            ' メッセージWORK
    '-----------------------------------------------------------------
    On Error Resume Next
    Set objFTP = CreateObject("BASP21.FTP")
    ' 接続失敗は終了(未インストール等)
    If Err.Number <> 0 Then
        MsgBox "「BASP21」に接続できません。"
        Exit Sub
    End If
    On Error GoTo 0
    '-----------------------------------------------------------------
    ' ユーザーフォーム(FRM_FTP)から接続情報を受け取る
    With FRM_FTP
        ' ユーザーフォームを表示
        .Show
        blnResult = .prpResult
        ' 登録されたか
        If blnResult Then
            strAddr = .prpAddr
            strUser = .prpUser
            strPass = .prpPass
            strRoot = .prpRoot
        End If
    End With
    Unload FRM_FTP
    ' フォーム上でキャンセルされたら終了
    If Not blnResult Then GoTo TEST_FTP_EXIT
    '-----------------------------------------------------------------
    ' ホスト接続
    vntRet = objFTP.Connect(strAddr, strUser, strPass)
    strMSG = objFTP.GetReply()
    ' 接続不成功か
    If vntRet <> 0 Then
        MsgBox "FTPサーバ(" & strAddr & ")接続不成功, Rc=" & vntRet & vbCr & strMSG
        GoTo TEST_FTP_EXIT
    End If
    swOpen = True
    ' ↓↓↓テストモ-ド対応↓↓↓
    If g_cnsTEST = 1 Then Debug.Print strMSG
    ' ↑↑↑テストモ-ド対応↑↑↑
    ActiveSheet.Cells.ClearContents
    '=================================================================
    ' ルートフォルダより処理開始
    Call GP_FTP_GetDir(objFTP, strRoot, 1, 1)
    '=================================================================
    ' ホスト切断(QUIT発行)
    vntRet = objFTP.Command("QUIT")
    strMSG = objFTP.GetReply()
    ' ↓↓↓テストモ-ド対応↓↓↓
    If g_cnsTEST = 1 Then Debug.Print strMSG
    ' ↑↑↑テストモ-ド対応↑↑↑
    If swOpen = True Then objFTP.Close

'===================================================================================================
' 終了
TEST_FTP_EXIT:
    Application.StatusBar = False
    Set objFTP = Nothing
    ThisWorkbook.Saved = True
End Sub

'***************************************************************************************************
'   ■■■ サブ処理(Private) ■■■
'***************************************************************************************************
'* 処理名 :GP_FTP_GetDir
'* 機能  :フォルダ単位処理
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :Arg1 = BASP21.FTP(Object)
'*      Arg2 = フォルダ名(String)
'*      Arg3 = シート上の行(Long)                      ※Ref参照
'*      Arg4 = シート上の列(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2006年01月14日
'* 作成者 :井上 治
'* 更新日 :2020年03月02日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:本処理は再帰動作、サンプルのため処理例外対応無し
'***************************************************************************************************
Private Sub GP_FTP_GetDir(ByRef objFTP As Object, _
                          ByVal strPath As String, _
                          ByRef lngRow As Long, _
                          ByVal lngCol As Long)
    '-----------------------------------------------------------------------------------------------
    Dim vntRet As Variant                                           ' 処理結果
    Dim lngIx As Long                                               ' テーブルINDEX
    Dim strCMDText As String                                        ' FTPコマンド
    Dim strPath2 As String                                          ' フォルダパス(編集)
    ' ↓↓↓テストモ-ド対応↓↓↓
    ' ※テストモードでは100件を超えたら下層のフォルダ探索は打ち切り
    If ((g_cnsTEST = 1) And (lngRow > 100)) Then Exit Sub
    ' ↑↑↑テストモ-ド対応↑↑↑
    '-----------------------------------------------------------------
    ' フォルダ名(階層状態を編集)を表示
    lngIx = 2
    Do While lngIx < lngCol
        strPath2 = strPath2 & tblPath(lngIx) & "/"
        lngIx = lngIx + 1
    Loop
    strPath2 = strPath2 & strPath
    Application.StatusBar = strPath2 & " 処理中...."
    ' フォルダ名を登録
    Cells(lngRow, lngCol).Value = "[" & strPath & "]" ' 自フォルダ名
    tblPath(lngCol) = strPath
    ' 行・列を加算
    lngRow = lngRow + 1
    lngCol = lngCol + 1
    '-----------------------------------------------------------------
    ' 当該フォルダに移動
    strCMDText = "CWD " & strPath
    ' ↓↓↓テストモ-ド対応↓↓↓
    If g_cnsTEST = 1 Then Debug.Print strCMDText
    ' ↑↑↑テストモ-ド対応↑↑↑
    vntRet = objFTP.Command(strCMDText)
    ' ↓↓↓テストモ-ド対応↓↓↓
    If g_cnsTEST = 1 Then Debug.Print objFTP.GetReply()
    ' ↑↑↑テストモ-ド対応↑↑↑
    ' 配下のサブフォルダを取得
    vntRet = objFTP.GetDir("", 1)
    ' 配列が作成されたか
    If IsArray(vntRet) Then
        For lngIx = LBound(vntRet) To UBound(vntRet)
            ' 下層のフォルダを参照(再帰呼び出し)
            Call GP_FTP_GetDir(objFTP, Trim(vntRet(lngIx)), lngRow, lngCol)
        Next lngIx
    Else
        ' ↓↓↓テストモ-ド対応↓↓↓
        If g_cnsTEST = 1 Then Debug.Print objFTP.GetReply()
        ' ↑↑↑テストモ-ド対応↑↑↑
    End If
    '-----------------------------------------------------------------
    ' 本フォルダのファイルリストを作成
    vntRet = objFTP.GetDir("", 2)
    ' 配列が作成されたか
    If IsArray(vntRet) Then
        For lngIx = LBound(vntRet) To UBound(vntRet)
            ' ファイルである条件を抽出(これが全てかは不明)
            If ((Left(vntRet(lngIx), 1) <> "d") And _
                (InStr(1, vntRet(lngIx), "<DIR>", vbTextCompare) = 0)) Then
                ' ファイル情報を登録
                Cells(lngRow, lngCol).Value = vntRet(lngIx)
                ' 次の行へ
                lngRow = lngRow + 1
            End If
        Next lngIx
    Else
        ' ↓↓↓テストモ-ド対応↓↓↓
        If g_cnsTEST = 1 Then Debug.Print objFTP.GetReply()
        ' ↑↑↑テストモ-ド対応↑↑↑
    End If
    '-----------------------------------------------------------------
    ' 上位フォルダに移動
    strCMDText = "CDUP"
    ' ↓↓↓テストモ-ド対応↓↓↓
    If g_cnsTEST = 1 Then Debug.Print strCMDText & "[" & strPath2 & "]"
    ' ↑↑↑テストモ-ド対応↑↑↑
    vntRet = objFTP.Command(strCMDText)
    ' ↓↓↓テストモ-ド対応↓↓↓
    If g_cnsTEST = 1 Then Debug.Print objFTP.GetReply()
    ' ↑↑↑テストモ-ド対応↑↑↑
End Sub

'----------------------------------------<< End of Source >>----------------------------------------
このように、プロシージャが2つに分かれていて、本来、呼び出される「TEST_FTP」の他に「GP_FTP_GetDir」があります。 この「GP_FTP_GetDir」は、Privateになっていて、引数もあるのでユーザーが「マクロ」から起動することはできず、 「TEST_FTP」から呼び出されて、1回に1つのフォルダ内のサブフォルダの探索と、ファイルの探索を行ないます。 このサブフォルダの探索時に自分自身である「GP_FTP_GetDir」がさらに呼び出されるように記述してあり、このような動作方法を「再帰動作」と呼びます。
一方では、その処理の最中であるのに、そこから「自分自身」が呼び出されて動作する方法で、この場合、プロシージャ内部の変数や記述部分は別プロシージャに記述されたように独立して動作しますが、 引数はそうは行きません。今回の記述では引数の前に「ByRef(参照渡し)」、「ByVal(値渡し)」を明記していますが、 これを省略した場合は「参照渡し」となり、呼ばれた先でこの引数の値を書き換えると、この後で呼び元に制御が戻ってからも書き換わった状態となります。
一方、「値渡し」は呼び元、呼び先でも変数は独立しており、「コピーが渡される」イメージです。 「再帰動作」の処理を記述する場合は、この引数が都合良く動作するようにByRef(参照渡し)」、「ByVal(値渡し)」を選択すれば良いのです。
フォルダを順次参照していき、その段階で下位フォルダの処理として、自分自身のプロシージャを呼び出しますが、呼ばれた先でさらに下位フォルダを見つけて自分自身のプロシージャを呼び出すことを繰り返す可能性もあります。 この方法だと、実情に合わせて自在に動作するわけですが、呼び出す時の「フォルダ名」と「カラム」は個々に独立しているので「ByVal(値渡し)」を指定しており、 「FTP」モジュールと順次カウントしていく「行」の変数は全体で1つで良いので「ByRef(参照渡し)」を使うわけです。

BASP21は、「メール送信(BASP21利用)ではAPIを呼び出す方法で利用していますが、 本来は「コンポーネント」なのでこのように「CreateObject関数」でオブジェクトへの参照を取得して扱うことができます。
この中の「FTP」に関する機能は、BASP21の中では「別オブジェクト(別クラス?)」として、BASP21 FTPオブジェクト」で説明されています。
こちらはあくまで利用記述のサンプルなので、メソッドなどの詳細は、このリンク先の説明を参照して下さい。

一応、ユーザーフォームのコードを紹介しておきます。
今回、ユーザーフォームとの変数の受け渡しは、モジュールレベル変数を利用しているので、フォーム側の記述では「処理開始」ボタンが押された時に 入力された内容をモジュールレベル変数に引き継いでやれば良いことになります。
本来は、この段階で未入力などのチェックを行なうべきなのですが、サンプルコードレベルなのでチェックは省略しています。

'***************************************************************************************************
'   FTPでファイル一覧を取得する                                     FRM_FTP(UserForm)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'06/01/14(1.00)新規作成
'20/03/02(1.10)*.xlsm化、他
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private g_strAddr As String                                 ' 接続先ホストアドレス
Private g_strUser As String                                 ' 接続ユーザー名
Private g_strPass As String                                 ' パスワード
Private g_strRoot As String                                 ' ホスト側ルートフォルダ
Private g_blnResult As Boolean                              ' 処理結果

'***************************************************************************************************
'   ■■■ コントロールイベント ■■■
'***************************************************************************************************
'* 処理名 :CMD_OK_Click
'* 機能  :「処理開始」ボタンイベント
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2006年01月14日
'* 作成者 :井上 治
'* 更新日 :2020年03月02日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub CMD_OK_Click()
    '-----------------------------------------------------------------------------------------------
    g_strAddr = Trim(TXT_ADDR.Text)                         ' 接続先ホストアドレス
    g_strUser = Trim(TXT_USER.Text)                         ' 接続ユーザー名
    g_strPass = Trim(TXT_PASS.Text)                         ' パスワード
    g_strRoot = Trim(TXT_ROOT.Text)                         ' ホスト側ルートフォルダ
    g_blnResult = True                                      ' 処理結果
    Me.Hide
End Sub

'***************************************************************************************************
'   ■■■ フォームイベント ■■■
'***************************************************************************************************
'* 処理名 :UserForm_Initialize
'* 機能  :フォーム初期化
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2006年01月14日
'* 作成者 :井上 治
'* 更新日 :2020年03月02日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_Initialize()
    '-----------------------------------------------------------------------------------------------
    If g_cnsTEST = 1 Then
        ' テストモード
        TXT_ADDR.Text = "ftp.hoge.co.jp"
        TXT_USER.Text = "anonymous"
        TXT_PASS.Text = "hoge@hoge.co.jp"
        TXT_ROOT.Text = "Pub"
    Else
        ' 本番モード
        TXT_ADDR.Text = ""
        TXT_USER.Text = ""
        TXT_PASS.Text = ""
        TXT_ROOT.Text = ""
    End If
    g_blnResult = False
End Sub

'***************************************************************************************************
'* 処理名 :UserForm_QueryClose
'* 機能  :ユーザーフォーム閉鎖動作
'---------------------------------------------------------------------------------------------------
'* 返り値 :(なし)
'* 引数  :(既定)
'---------------------------------------------------------------------------------------------------
'* 作成日 :2006年01月14日
'* 作成者 :井上 治
'* 更新日 :2020年03月02日
'* 更新者 :井上 治
'* 機能説明:
'* 注意事項:
'***************************************************************************************************
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    '-----------------------------------------------------------------------------------------------
    ' 閉じる[×]ボタンか
    If CloseMode = vbFormControlMenu Then
        Cancel = True
    End If
End Sub

'***************************************************************************************************
'   ■■■ プロパティ ■■■
'***************************************************************************************************
'   接続先ホストアドレス
'---------------------------------------------------------------------------------------------------
Friend Property Get prpAddr() As String
    prpAddr = g_strAddr
End Property

'===================================================================================================
'   接続ユーザー名
'---------------------------------------------------------------------------------------------------
Friend Property Get prpUser() As String
    prpUser = g_strUser
End Property

'===================================================================================================
'   パスワード
'---------------------------------------------------------------------------------------------------
Friend Property Get prpPass() As String
    prpPass = g_strPass
End Property

'===================================================================================================
'   ホスト側ルートフォルダ
'---------------------------------------------------------------------------------------------------
Friend Property Get prpRoot() As String
    prpRoot = g_strRoot
End Property

'===================================================================================================
'   処理結果
'---------------------------------------------------------------------------------------------------
Friend Property Get prpResult() As Boolean
    prpResult = g_blnResult
End Property

'----------------------------------------<< End of Source >>----------------------------------------