[[20161111172522]]　『VBAでファイルパスから特定文字列の抽出とファイメx（Seto）　ページの最後に飛ぶ

『VBAでファイルパスから特定文字列の抽出とファイル形式のフィルタリング』（Seto）

下記にソースコードの一部を掲載していますので、ご参照の上お助け頂ければありがたいです。

マクロの概要としては、大量のSSを直下にサブフォルダ毎に保存したルートとなるフォルダを選択し、そのフォルダの一下層下にある画像ファイルをフォルダ毎にシートを挿入しながらExcel上に貼り付けていく物です。

１、ルートフォルダの選択
２、ルートフォルダ直下にあるサブフォルダの検出
３、サブフォルダ毎にFor文を回しその際にサブフォルダ毎にシート作成と貼り付けメソッドの呼び出し
４、シート作成時にフォルダパスから「最後の\マーク以降の文字列を抜き出し」それをアクティブシートのシート名に適用

C:\Users\seto\dummy\test\WANTED
↑つまりこのWANTEDの文字だけ出力したい(文字数異なるケースがある為、決め内では無く正規表現を使って行いたい)

５、貼り付け時に画像ファイル以外のファイルを除外
↓下記ソースコード内の変数「File_Name」にFor文毎に格納されてる情報
C:\Users\seto\dummy\test\20130508-152855.jpg
C:\Users\seto\dummy\test\20130508-153015.png
C:\Users\seto\dummy\test\\Thumbs.db
↑全ファイル貼り付けると最後のThumbsが入ってしまう為必要になった処理、つまり貼り付け自体はこの後のメソッドで成功している。
こちらも正規表現で[*.jpg or *.png]のみ検出するようにしたい。

大まかな流れとしては上記の様になっており、４と５でつまづいています。
ドキュメントのまとめに急遽マクロが必要になった為、VBA自体学び始めて2~3日の初学者なので、随分と慣用表現やコード作成時の約束事に疎い見づらい物とは思いますが、何卒よろしくお願いいたします。

Sub ScanDir(Root_Path As Variant)
'引数になってるフォルダの派生フォルダを検出するメソッド

    Dim CO_SFSO, Sub_Dir, Root_Dir
    Set CO_SFSO = CreateObject("Scripting.FileSystemObject")
    Set Root_Dir = CO_SFSO.Getfolder(Root_Path)
    'クリエイトオブジェクトで引数パス直下の各フォルダを１つの変数に代入

    For Each Sub_Dir In Root_Dir.SubFolders
        MakeSheet CStr(Sub_Dir)
        '新規シート作成メソッド
　　　　ScanFile CStr(Sub_Dir)
　　　　'ファイル検出メソッド
    Next Sub_Dir
    '全フォルダ名の入った変数からFor文内で同じ変数へ繰り返し代入
    '代入する度にフォルダ毎に必要なメソッドの呼び出し

End Sub

Sub MakeSheet(Sub_Dir As Variant)

    Dim Sheet_Name As String
    Sheet_Name = Sub_Dir
　　'【要】これだと適用されない、また、フルパスなのでシート名として適切では無い
    Worksheets.Add

End Sub

Sub ScanFile(Sub_Dir As Variant)
'変数で受け取ったファイルパスの中から画像ファイルを抽出して貼り付けようメソッドに送るメソッド

    Dim CO_SFSO, File_Name
    Set CO_SFSO = CreateObject("Scripting.FileSystemObject")

    For Each File_Name In CO_SFSO.Getfolder(Sub_Dir).Files
        '【要】このタイミング(？)画像ファイル対象のフィルタリング
        PasteFile CStr(File_Name)
        'AddPictureを利用した貼り付け用メソッド
    Next File_Name

End Sub

＜使用 Excel：unknown、使用 OS：Windows7 ＞

 大量のSS って？

 まぁ、それはさておき、アップされたコードには目を通していませんし、要件説明も精読していませんが

 ４．については　正規表現を持ち出すまでもなく、たとえば

 Sub Test()
    Dim s As String
    Dim w As Variant

    s = "C:\Users\seto\dummy\test\WANTED"
    w = Split(s, "\")
    MsgBox w(UBound(w))

 End Sub

 こんなコードで取得できますよ。
 FSO の　GetBaseNameメソッドでも、拡張子を除いた部分を取得できますが。

（β） 2016/11/11(金) 18:00

 ５．についても、正規表現は、さらさら必要なく（使ってみたいということなら別ですが）

 単純に　取得ファイル名の　末尾4桁　が .png か .jpg のものを採用するということでよろしいのでは？

 ただ、ファイルとしては .PNG とか .JPG もありますので、ファイル名下４桁を Lcase で　小文字変換して
 判定する（あるいは UCase で大文字変換して判定）ことは必要ですね。

（β） 2016/11/11(金) 18:04

 ４．は以下の１行でも取得できますね。

 Sub Test2()
    Dim s As String

    s = "C:\Users\seto\dummy\test\WANTED"

    MsgBox Right(s, InStr(StrReverse(s), "\") - 1)

 End Sub

（β） 2016/11/12(土) 08:45

SSの内容は主にソフトウェアのGUI上操作を画像で記録した物になります。
ほぼワンクリック毎に毎回SSを取得するような作業となっている為、手作業でシートに貼り付けていると日が暮れる為、マクロの作成に取り掛かりました。

皆様のおかげで４については「InStr」を活用してフルパスから最後の"\"以降を取得、それを変数に入れてからアクティブシートの名称変更に転用する事で解決しました。
まだまだVBAのコマンドについて、基礎的な部分も把握していないのでとても助かります。

ただ、５についてはヒントを頂いたにも関わらず未だ苦戦しております。
末尾四桁に拡張子での判定を行う方法が手っ取り早いのは分かるのですが、その方法が分かりません。
Filter関数なる物でVariant型にフルパスが入った変数をフィルタリングしたのですが、エラーになってしまいました。
File_Name = Filter(File_Name, ".jpg" Or ".png", True, vbTextCompare)
使用したコードはこれです。

（Seto） 2016/11/14(月) 10:21

拡張子判定は、If文で2つの条件を書くだけであり、正規表現の必要はありませんよね？
また、フォルダ毎に画像があるような表現をされていますが、フルパス例にはそれがありません。

とりあえず、画像ファイル名の1つ上がシート分けしたいフォルダなのだろうと仮定したコード例なぞ。画像サイズは固定にしています。
なお、追記は考えていないので、1回実行する度に、フォルダ名シートは全て削除しておいてください。

 Sub test()
    Const cPATH = "C:\Users\seto\dummy\test\"
    Dim DIC As Object
    Dim cFiles As Variant
    Dim vw As Variant
    Dim cw As String
    Dim i As Long

    Set DIC = CreateObject("Scripting.Dictionary")

    cFiles = Split(CreateObject("WScript.Shell").Exec("CMD /C DIR /A:-D/B/S """ & cPATH & "*.*""").StdOut().ReadAll(), vbNewLine)
    For i = 0 To UBound(cFiles) - 1
        cw = LCase(Right(cFiles(i), 4))
        If cw = ".jpg" Or cw = ".png" Then
            vw = Split(cFiles(i), "\")
            cw = vw(UBound(vw) - 1)
            If Not DIC.Exists(cw) Then
                DIC.Add cw, 0
                Sheets.Add after:=Sheets(Sheets.Count)
                Sheets(Sheets.Count).Name = cw
            End If
            With Sheets(cw).Shapes.AddPicture(cFiles(i), msoFalse, msoTrue, 0, DIC(cw), 640, 400)
                DIC(cw) = DIC(cw) + .Height
            End With
        End If
    Next i

    Set DIC = Nothing
 End Sub
（???） 2016/11/14(月) 11:33

５について自己解決に至りますたので報告します。

「InStrRev」を活用し各ファイルのフルパスから拡張子の「.」の位置を取得し変数Aに代入。
変数Aとフルパスの比較から拡張子の種類が識別可能な「Select Case」関数を用意し、画像拡張子の場合のみに画像貼り付けメソッドが呼び出されるよう設定。

以上の方法で解決しました。
これで要件は整ったのでこの質問は半クローズとします。
もっとスマートな方法がいくつもあると思うので、皆様のやり方を見せていただけると幸いです。

ありがとうございました。

（Seto） 2016/11/14(月) 11:38

ほぼ同じタイミングで更新があったようですので、改めてお礼をさせて頂きます。
変数宣言等きっちりしていてとても参考になります。

既に要件は満たしたので作業は行えますが、時間のある時にコードを見させてもらいながらアップデートに挑戦してみます。
（Seto） 2016/11/14(月) 11:41

コメント返信：

[ 一覧(最新更新順) ]

[[20161111172522]] 『VBAでファイルパスから特定文字列の抽出とファイメx（Seto） ページの最後に飛ぶ

[[20161111172522]]　『VBAでファイルパスから特定文字列の抽出とファイメx（Seto）　ページの最後に飛ぶ