【VBA】Onedriveのファイルで、VBAのFileSystemObjectを使ってみる

あまりにもコード書かなさすぎて不安と強迫観念が辛いので自己肯定感を高めるために簡単なスクリプトを書くことにしました。

書くといってもネットのコピペの継ぎ接ぎキメラコードです。
これを果たして書くと言っていいのか。それはさておき。

インターネット、それも最近のSNSやってたらとんでもない量の画像コンテンツが流れてくるわけです。
すんばらしぃ画像の数々はしれっと保存させて頂いております。
フォルダ分けも作品タイトルとか特定ブランドでがっつりした大分類で分けてます。

今日はここでどのフォルダがいくつファイル数があるかをカウントしてみます。

主に参考にさせて頂くのはこちらです。

【VBA】FSOでファイル名一覧とサブフォルダ名一覧を取得する方法 | やろまいCode

フォルダの一覧を取得する

それではまず、画像フォルダそれぞれのフォルダ名を取得してワークシート上に吐き出していきます。

今回は記事名の通り、FileSystemObjectでいきますのでまず参照設定を確認

ツール > 参照設定 > Microsoft Scripting Runtime

チェックが入っていないのでチェックを入れます。

それではコピペソースを用意します。

改造箇所として、
・アクティブのExcelブックのフルパスを取得し、その中のサブフォルダを取得しにいく
・A2から順にサブフォルダ名を出力する
の2点があります。

Sub GetFolderDirectory()
    
    Dim FolderPath  As String
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    Dim objFolder As Folder: Set objFolder = fso.GetFolder(ActiveWorkbook.Path)
    
    'サブフォルダ名の表示
    Dim objSubFolder As Folder
    Dim i As Integer: i = 1
    For Each objSubFolder In objFolder.SubFolders
        i = i + 1
        ActiveSheet.Cells(i, 1).Value = objSubFolder.Name
    Next
    
End Sub

実行

パスが見つからないようです。
事前にイミディエイトウインドウで叩いたらこんな感じで取れてたので、
てっきりいけるとおもってました。

塗りつぶしてるのはなんか危なそうな英数字の羅列

Onedrive（クラウド）なので、httpsで始まるのはわかりますが、
普段ファイルパスをエクスプローラー上で取得している時はcドラなりOnedriveと同期している箇所からのパスになるのでそこは気になります。
↓エクスプローラーで取得したファイルのフルパス

"C:\Users\xxx\OneDrive - xxx\ディレクトリ名\ファイル名"

恐らくこっちで取得すればこのエラーは解消される気がしてます。

調べたところ、https始まりで返すのは仕方ないっぽい。
こちらの記事がこの問題の要点を簡潔にまとめてくださっていて助かった。

【ThisWorkbook.Pathだとダメ】OneDriveで同期しているファイルのローカルパス取得方法【VBA】 - Qiita

要は使いたいフォルダパスが取得できないのであれば自作すればいいということらしい。

ということで変数にもうこのファイルがあるディレクトリをそのまま突っ込む。汎用性は意図的に意識していません。

Dim OnedrivePath As String: OnedrivePath = "C:\Users\xxx\OneDrive - xxx\ディレクトリ名"

Sub GetFolderDirectory()
    
    Dim FolderPath  As String
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    Dim OnedrivePath As String: OnedrivePath = "C:\Users\xxx\OneDrive - xxx\ディレクトリ名"
    Dim objFolder As Folder: Set objFolder = fso.GetFolder(OnedrivePath)
    
    'サブフォルダ名の表示
    Dim objSubFolder As Folder
    Dim i As Integer: i = 1
    For Each objSubFolder In objFolder.SubFolders
        i = i + 1
        ActiveSheet.Cells(i, 1).Value = objSubFolder.Name
    Next
    
End Sub

改修結果が上記
実行結果が下記

想定通り出力されています

ファイル数を取得する

元々別関数で作成してFor文内で呼ぶつもりでした。
1文で済むことに気づいたのでFor文の中でやっちゃいます。

Sub GetFolderDirectory()
    
    Dim FolderPath  As String
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    Dim OnedrivePath As String: OnedrivePath = "C:\Users\xxx\OneDrive - xxx\ディレクトリ名"
    Dim objFolder As Folder: Set objFolder = fso.GetFolder(OnedrivePath)
    
    Dim objSubFolder As Folder
    Dim i As Integer: i = 1
    For Each objSubFolder In objFolder.SubFolders
        i = i + 1
        ActiveSheet.Cells(i, 1).Value = objSubFolder.Name
        ActiveSheet.Cells(i, 2).Value = objSubFolder.Files.Count '追加
    Next
    
End Sub

実行結果

取得できました

以上。
楽しかった。

得られた知見としては
VBAでOnedrive上のファイルを取り扱う時のフルパスの取得方法
今回は私物PCのローカルだったので問題なく解決できましたが、
業務用PCで会社ドメインで使用してるOnedriveだとしっかりとした変換かけないといけないと思います。