VBA / Excel - найти путь для сохранения файла, но соответствует только определенной части пути
Вопрос
Я хотел бы сохранить файл в следующем примере папку:
C:\MainFolder\Subfolder1\Subfolder2\Subfolder3_A_abc_123
В папке есть и другие подпапки, где я бы хотел, чтобы файл был сохранен, например:
Subloder_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.
п
Решение
Вы могли бы просто закрутить все подкаталогии и для каждого каталога, который вы сравниваете его с пути, который вы хотите найти. Что-то вроде этого псевдо-кода должно работать:
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
Другие советы
Ничего плохого в размещенном решении. Я просто подумал, что я бы также опубликовал другую альтернативу, используя 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