VBA / Excel - найти путь для сохранения файла, но соответствует только определенной части пути - PullRequest
Новая
       23

VBA / Excel - найти путь для сохранения файла, но соответствует только определенной части пути

0 голосов
/ 14 декабря 2010

Я хотел бы сохранить файл в следующем примере папки:

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 & "*")

Не могли бы вы взглянуть на это? Имена папок и рабочих книг изменены, поэтому они могут не иметь никакого смысла. Важна только часть папки.

Заранее спасибо.

1035 * Rgds *

P

Ответы [ 2 ]

0 голосов
/ 24 ноября 2014

Ничего плохого в размещенном решении. Я просто подумал, что я также опубликую другую альтернативу, используя функцию 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
0 голосов
/ 14 декабря 2010

Вы можете просто перебрать все подкаталоги, и для каждого каталога вы сравните его с путем, который вы хотите найти. Что-то вроде этого псевдокода должно работать: 

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

...