Question

我想保存在VBA中运行代码时创建的一些模板文件。我想将它们保存在活动工作簿之前一步的filder路径中的特定文件夹中。如何在代码中动态获取路径？

我有一个名为Path的字符串变量，其值为thisworkbook.path。我想命名这个新的字符串变量PathBefore。

Sub Initialize()

Set MainWB = ThisWorkbook
Set MainSheet = MainWB.Worksheets("Main")
SLRow = MainWB.Worksheets("SAP").Cells(Rows.Count, "A").End(xlUp).Row
ELRow = MainWB.Worksheets("Employees").Cells(Rows.Count, "A").End(xlUp).Row
MLRow = MainSheet.Cells(Rows.Count, "A").End(xlUp).Row
ListLR = MainWB.Worksheets("Lists").Cells(Rows.Count, "A").End(xlUp).Row
Set emp = MainSheet.Range("A1:A" & MLRow)
Path = ThisWorkbook.Path 'here is path variable
End Sub

Sub Create_Workbook()
    'Create new workbook and copy the data into it in an Export folder

    Call Initialize
    Dim DiklaWB As Workbook
    Dim StandartWB As Workbook
    Dim tmpWB As Workbook




'Standart 02 Workbbok
With MainWB.Worksheets("Employees")
    .Range("$A$1:$M$" & ELRow).AutoFilter Field:=13, Criteria1:=MainWB.Worksheets("Lists").Range("I1")
    .Range("$A$2:$M$" & ELRow).SpecialCells(xlCellTypeVisible).Copy
End With

Set StandartWB = Application.Workbooks.Add
StandartWB.Worksheets(1).Cells(2, 1).PasteSpecial xlPasteValues
MainWB.Worksheets("Employees").Range("A1:M1").Copy
StandartWB.Worksheets(1).Cells(1, 1).PasteSpecial xlPasteValues
StandartWB.SaveAs Filename:=Path & "\Export\ 02 .xlsx" 'I want to save it in the folder before thisworkbok.path
StandartWB.Close
End Sub

Answer 1

您可以使用

Dim pathChunks As Variant
pathChunks = Split(ThisWorkbook.Path, "\")
ReDim Preserve pathChunks(1 To Ubound(pathChunks)-1)
Path = Join(pathChunks, "\")

或者

Path = Left(ThisWorkbook.Path, InstrRev(ThisWorkbook.Path, "\") - 1)

Answer 2

使用以下三行替换Initialize（）子句中的最后一行：

With CreateObject("Scripting.FileSystemObject")
    Path = .GetParentFolderName(ThisWorkbook.Path)
End With

如果工作簿位于根目录中，上面的代码将返回双引号（＆＃34;＆＃34;）而不是错误，例如c：\

VBA文件夹路径文件前一步

2 个答案: