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更强大的正则表达式，但我不认为你需要它。但是，以防万一，您可以在此处找到相关信息：How to Use Regular Expressions in 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

VBA / Excel - 查找保存文件的路径，但仅匹配路径的某个部分

2 个答案: