VBA/Excel-ファイルを保存するためのパスを見つけるが、パスの特定の部分のみを一致させる

Question

次の例フォルダーにファイルを保存したい：

C:\MainFolder\Subfolder1\Subfolder2\Subfolder3_A_abc_123

フォルダーには、ファイルを保存したい他のサブフォルダーがあります。

subfolder_b_xyz_456

subfolder_c_rst_789

等

問題は、「Subfolder3_」までのパス上のフォルダーを見つけたいということです。「a」はシートの範囲と「_ABC_123」からフェッチされ、一致したくありません。

誰かが賢いFSOの例や他の創造的なソリューションを持っていますか？私はプログラミングが初めてなので、どんな提案にも感謝されています。

前進してくれてありがとう。

PythonStyle

---

HO1への質問を更新しました：

これはコードです：

Sub Create_WorkB_Input()

Dim wbBook1 As Workbook
Dim wbBook2 As Workbook
Dim shTemp1 As Worksheet
Dim shTemp2 As Worksheet
Dim shTemp_admin As Worksheet
Dim shTSSR_inp1 As Worksheet
Dim shTSSR_inp2 As Worksheet
Dim strVersion As String
Dim strPrep As String
Dim Datecr As Date
Dim strComment As String
Dim intBatch As Integer
Dim strSiteID As String
Dim strClusterID As String
Dim strPath As String
Dim fso As New FileSystemObject
Dim flds As Folders
Dim f As Folder

Set wbBook1 = Workbooks("Name_Input_TEMPLATE_v4.0.xls")
Set wbBook2 = Workbooks("Name_Input_To_xxx.xlsm")
Set shTemp1 = Workbooks("Name_Input_TEMPLATE_v4.0.xls").Sheets("TSSR_Input_sh1")
Set shTemp2 = Workbooks("Name_Input_TEMPLATE_v4.0.xls").Sheets("TSSR_Input_sh2")
Set shTSSR_inp1 = Workbooks("Name_Input_To_xxx.xlsm").Sheets("xxx")
Set shTSSR_inp2 = Workbooks("Name_Input_To_xxx.xlsm").Sheets("yyy")
Set shTemp_admin = Workbooks("Name_Input_TEMPLATE_v4.0.xls").Sheets("www")

shTSSR_inp1.UsedRange.Copy

shTemp1.Paste

shTSSR_inp2.UsedRange.Copy

shTemp2.Paste

intBatch = shTemp1.Range("AQ2").Value
strSiteID = shTemp1.Range("A2").Value
strClusterID = shTemp1.Range("B2").Value
strComment = InputBox(Prompt:="Insert comments.", Title:="INSERT COMMENTS", Default:="New site - batch " & intBatch & " ref email fr Me dato")

With shTemp_admin
    .Range("A18").FormulaR1C1 = "4.0"
    .Range("B18").Value = "John Doe"
    .Range("C18").Value = Date
    .Range("D18").Value = strComment
End With

strPath = "D:\Path_to_folder\folder1\folder2\folder3\folder4"

Set flds = fso.GetFolder(strPath & "\Folder5_Input_Batch_" & intBatch & "*")

For Each f In flds


    If f.Name Like strPath Then



        wbBook1.SaveAs Filename:="" + strPath + "\" + "TSSR_Input_" + strClusterID + "_" + strSiteID + "_v4.0.xls", _
                FileFormat:=xlNormal, _
                Password:="", _
                WriteResPassword:="", _
                ReadOnlyRecommended:=False, _
                CreateBackup:=False

    End If

Next

End Sub

この行でエラーが発生しています：

Set flds = fso.GetFolder(strPath & "\Folder5_Input_Batch_" & intBatch & "*")

見ていただけますか？フォルダーとワークブックの名前が変更されているため、意味をなさない場合があります。フォルダーパーツのみが重要です。

前もって感謝します。

RGDS

p

Answer 1

すべてのサブディレクトリをループするだけで、各ディレクトリに対して、見つけたいパスと比較できます。この擬似コードのようなものは機能するはずです：

For each dir in SubDirectories
  Dim lookingFor as String
  lookingFor = "Subfolder3_" & yourVariable & "*"
  If dir.Name Like lookingFor Then ' Note the use of the Like operator here so that it sees the * as a wildcard
    ' This is the right one
  End If
Next

他の、同様のオプションは、より強力な正規表現を使用することです Like, 、しかし、私はあなたがそれを必要とするとは思わない。ただし、念のため、こちらで情報を見つけることができます。 Visual Basicで正規表現を使用する方法

Answer 2

投稿されたソリューションには何の問題もありません。私はまた、別の代替品を投稿すると思っただけです Dir() 機能。これは少し速いはずです - 特に検索するサブディレクトリがたくさんある場合。

すなわち

Dim strFoundDir as String

strFoundDir=dir("C:\MainFolder\Subfolder1\Subfolder2\SubFolder3*" & SomeVariable & "*", vbDirectory)
    if lenb(strFoundDir)>0 then
        'Do the rest of your code
    end if