プロが教える店舗&オフィスのセキュリティ対策術

いつもお世話になっております。
添付ファイルのように
各国 のフォルダの中に
19-003アメリカ  このフォルダの中に  発注処理済
20-001タイ    このフォルダの中に  発注処理未
21-001アメリカ  このフォルダの中に  発注処理済
21-002イギリス  このフォルダの中に  発注処理済
21-004インド   このフォルダの中に  発注処理未

があります。

21から始まり、その発注処理済のパスだけを
抽出したいのです
VBS VBA bat でもなんでもいいです。
教えてくれませんでしょぅか

下記はBATだめでした。
@echo off
dir 発注処理済\/21- * /s /ad /on /b > 発注済oみ列挙.txt

C:\Users\***r\*****は個人情報のため

下記のような結果になりたい。
C:\Users\***r\*****\デスクトップ\各国\21-001アメリカ\発注処理済
C:\Users\***r\*****\デスクトップ\各国\21-002イギリス\発注処理済
C:\Users\***r\*****\デスクトップ\各国\21-004インド\発注処理済

「subfolderのバスを取得」の質問画像

質問者からの補足コメント

  • へこむわー

    ありがとうございます
    やり方わかりせんです。

    No.1の回答に寄せられた補足コメントです。 補足日時:2021/09/21 19:45
  • つらい・・・

    発注済み列挙.txtが入っているフォルダ名
    で21がついていてその中のsubforlder
    が発注済です
    むりそうなのでありがとうございました

    No.2の回答に寄せられた補足コメントです。 補足日時:2021/09/21 19:58
  • うーん・・・

    19-003アメリカ  このフォルダの中に  発注処理済
    20-001タイ    このフォルダの中に  発注処理未
    21-001アメリカ  このフォルダの中に  発注処理済
    21-002イギリス  このフォルダの中に  発注処理済
    21-004インド   このフォルダの中に  発注処理未

    結果 下記を表示したいのです

    21からはじまる発注処理済 ★

    21-001アメリカ  このフォルダの中に  発注処理済
    21-002イギリス  このフォルダの中に  発注処理済

    No.4の回答に寄せられた補足コメントです。 補足日時:2021/09/21 20:23
gooドクター

A 回答 (6件)

すみません、一部、修正が必要です。



Dim cnt As Long,n as Long

Sub Sample3(Path As String)
  Dim buf As String, f As Object
  buf = Dir(Path & "\発注済み列挙.txt")
  Do While buf <> "" ’全てのフォルダが取得される → 絞り込み
   n=Ubound(Split(bur,"\"))
If Split(bur,"\")(n-1) Like "21* Then " ' これで、発注済み列挙.txtのフォルダ名を取得
    cnt = cnt + 1
    Cells(cnt, 1) = buf
End If ’ <= 修正 : 下記構文と入れ替え
    buf = Dir() ’ <= 修正 : これは必要でした。。。
  Loop
  With CreateObject("Scripting.FileSystemObject")
    For Each f In .GetFolder(Path).SubFolders
      Call Sample3(f.Path)
    Next f
  End With
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございました
自力でなんとかできました。なんか
mygoonickname レベル高すぎでむりです。
ありがとうございました

For Each fol In fso.GetFolder(mainFolder).subfolders
If fol.Name Like "21-*" Then

For Each f In fol.subfolders
If f.Name = "発注処理済" Then
Cells(i, 4).Value = fol.Name & f
恥ずかしいですが

お礼日時:2021/09/21 21:14

こんばんは。



最初は、下記の様に呼び出しが必要です。。。

Sub 開始()
Call Sample3("最初の親フォルダを指定")
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございました

お礼日時:2021/09/21 21:15

こんばんは、


横からすみません
拾い物の使い回しですが、多分こういう事かな、、、
FSOなのでDir関数より少し遅いかもです

Option Explicit
Private parentPath As String
Dim Ary()
Sub ListFolders()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
parentPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\各国"

On Error GoTo ErrHndl
listSubFolders fso.GetFolder(parentPath), 0

Cells(1, 1).Resize(UBound(Ary) + 1, 1) = Ary

ExitSub:
Set fso = Nothing
Exit Sub
ErrHndl:
MsgBox Err.Description
Err.Clear
GoTo ExitSub
End Sub

Private Sub listSubFolders(ByVal mlFol As Object, ByRef n As Long)
Dim fol As Object
For Each fol In mlFol.SubFolders
If fol.Path Like "*発注処理済" Then
ReDim Preserve Ary(n)
Ary(n) = fol.Path
n = n + 1
End If
listSubFolders fol, n
Next
Set fol = Nothing
End Sub

出力はA1セルからにしています
この回答への補足あり
    • good
    • 0
この回答へのお礼

ありがとうございました

お礼日時:2021/09/21 21:15

No.2で、発注済み列挙.txtが入っているフォルダ名が全て表示されると思ったのですが、それを更に絞り込んでは、ダメでしょうか?


因みに、結果を、Excelのセルに表示になりますが。

手書きなので、エラーが出るかも知れませんが、
  n=Ubound(Split(bur,"\"))
  Split関数で、\で文字を区切ります。
  Uboundで、それが幾つに区切られたかを取得 nに入る
  n-1で、\で区切られた文字の右側から2番目を取得:txtのフォルダ
  If Split(bur,"\")(n-1) Like "21* Then 21で始まるフォルダ名


Dim cnt As Long,n as Long

Sub Sample3(Path As String)
  Dim buf As String, f As Object
  buf = Dir(Path & "\発注済み列挙.txt")
  Do While buf <> "" ’全てのフォルダが取得される → 絞り込み
   n=Ubound(Split(bur,"\"))
If Split(bur,"\")(n-1) Like "21* Then " ' これで、発注済み列挙.txtのフォルダ名を取得
    cnt = cnt + 1
    Cells(cnt, 1) = buf
    buf = Dir()
End If
  Loop
  With CreateObject("Scripting.FileSystemObject")
    For Each f In .GetFolder(Path).SubFolders
      Call Sample3(f.Path)
    Next f
  End With
End Sub
    • good
    • 0
この回答へのお礼

この短時間でこんなにかけるんですか
すごいですね
標準モジュールにいれて実行でいいのかわかりませが、
やりましたがなにもおきませんでした。

お礼日時:2021/09/21 20:19

No.1の者です。



発注済み列挙.txtが入っているフォルダ名を取得したいと思ったのですが、
 違ったでしょうか?

Dim cnt As Long

Sub Sample3(Path As String)
  Dim buf As String, f As Object
  buf = Dir(Path & "\発注済み列挙.txt")
  Do While buf <> ""
    cnt = cnt + 1
    Cells(cnt, 1) = buf
    buf = Dir()
  Loop
  With CreateObject("Scripting.FileSystemObject")
    For Each f In .GetFolder(Path).SubFolders
      Call Sample3(f.Path)
    Next f
  End With
End Sub
この回答への補足あり
    • good
    • 0

こんばんは。



Excel VBAの再帰呼び出しの例ですが、どうでしょうか?

サブフォルダを含めてファイル一覧を取得する(Dir関数の再帰呼び出し)
https://www.moug.net/tech/exvba/0060088.html
この回答への補足あり
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング