0

次の例のフォルダーにファイルを保存したいと思います。

C:\MainFolder\Subfolder1\Subfolder2\Subfolder3_A_abc_123

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

Subfolder_B_xyz_456

Subfolder_C_rst_789

等

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

巧妙な FSO の例やその他の創造的なソリューションを持っている人はいますか? 私はプログラミングが初めてなので、どんな提案でも大歓迎です。

よろしくお願いします。

パイソンスタイル

質問を 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

4

2 に答える 2

0

投稿されたソリューションに問題はありません。関数を使用して別の代替案も投稿すると思いました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
于 2014-11-24T17:37:07.070 に答える
0

すべてのサブディレクトリをループして、ディレクトリごとに検索したいパスと比較することができます。この疑似コードのようなものが動作するはずです:

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 で正規表現を使用する方法

于 2010-12-14T12:45:53.190 に答える