VBA/Excel - 查找保存文件的路径,但仅匹配路径的特定部分
我想将文件保存在以下示例文件夹中:
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
I'd like to save a file in the following example folder:
C:\MainFolder\Subfolder1\Subfolder2\Subfolder3_A_abc_123
There are other subfolders in the folder where I'd like the file be saved, like:
Subfolder_B_xyz_456
Subfolder_C_rst_789
etc
The thing is that I want to find a folder on the the path all the way up to: "Subfolder3_", the "A" will be fetched from a range in a sheet and the "_abc_123", I do not want to match.
Does anyone have a clever FSO example or other creative sollution? I'm new to programming so any suggestion is appreciated.
Thanks on advance.
PythonStyle
Updated question to ho1:
This is the code:
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
I am getting error at this line :
Set flds = fso.GetFolder(strPath & "\Folder5_Input_Batch_" & intBatch & "*")
Could you please have a look at it?
The names of folders and workbooks are changed so they might not make any sense. Only the folder part is important.
Thanks in advance.
Rgds
P
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(2)
您可以循环遍历所有子目录,并对每个目录将其与要查找的路径进行比较。像这样的伪代码应该可以工作:
另一个类似的选项是使用比
Like
更强大的正则表达式,但我认为您不需要它。不过,为了以防万一,您可以在此处找到相关信息:如何在 Visual Basic 中使用正则表达式< /a>You could just loop through all the subdirectories and for each directory you compare it with the path you want to find. Something like this pseudo code should work:
An other, similar, option would be to use regular expressions which are more powerful than
Like
, but I don't think you'd need that. However, just in case, you can find information about it here: How to Use Regular Expressions in Visual Basic发布的解决方案没有任何问题。我只是想我还会使用
Dir()
函数发布另一个替代方案,它应该更快一点 - 特别是如果您有很多子目录需要搜索。IE
Nothing wrong with the posted solution. I just thought I would also post another alternative using the
Dir()
function, which should be a little faster - especially if you have a lot of subdirectories to search.i.e.