VBA Excel сохранение файла в папке, созданной макросом Excel

Question

Я хотел бы сохранить свой файл в папке, созданной ... макросом Excel.

Процесс создания папки vba excel представлен здесь:

Создать папка и подпапка в Excel VBA

После этого я назначил ее моей ситуации:

 Sub Createfolder ()
     Dim fso As Object
     Dim fldrtitle As String
     Dim flrdrname As String
     Dim fldrpath As String

     Set fso = CreateObject("scripting.filesystemobject")
     fldrtitle = Worksheets("Sheet1").Range("A2").Value
     fldrname = "Pre-planning NBU " & fldrtitle
     fldrpath = "H:\ProfileV2\Desktop\Pre planning NBU\ Alex list new\" & fldrname
     If not fso.FolderExists(fldrpath) Then
         fso.Createfolder (fldrpath)
     End If
 End Sub

Где папка была создана. Мой способ сохранения файла, согласно предыдущему запросу , выглядит следующим образом:

Sub Save()
    Dim name As String, Custom_Name As String

    name = Worksheets("Sheet1").Range("A2").Value
    Custom_Name = ThisWorkbook.Path & "\" & "NBU " & name & " - Opportunity list.xlsx"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=Custom_name, FileFormat:=51
End Sub

Теперь я попытался объединить их вместе в какой-то момент, где был путь 1:

Sub Save()
    Call Createfolder

    Dim name As String, Custom_Name As String

    name = Worksheets("Sheet1").Range("A2").Value
    Custom_Name = ThisWorkbook.Path & Createfolder & "NBU " & name & " - Opportunity list.xlsx"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=Custom_name, FileFormat:=51
End Sub

Здесь я получаю сообщение об ошибке: Ожидаемая функция или переменная

что я понял, поскольку я не могу извлечь внешний макрос внутри кода.

Впоследствии я попробовал другой способ:

 Sub Savetofolder ()
     Dim fso As Object
     Dim fldrtitle As String
     Dim flrdrname As String
     Dim fldrpath As String
     Dim name As String, Custom_Name As String

     Set fso = CreateObject("scripting.filesystemobject")
     fldrtitle = Worksheets("Sheet1").Range("A2").Value
     fldrname = "Pre-planning NBU " & fldrtitle
     fldrpath = "H:\ProfileV2\Desktop\Pre planning NBU\ Alex list new\" & fldrname
     If not fso.FolderExists(fldrpath) Then
         fso.Createfolder (fldrpath)
     End If

 'name = Worksheets("Sheet1").Range("A2").Value
     Custom_Name = ThisWorkbook.Path & Createfolder & "NBU " & fldrtitle & " - Opportunity list.xlsx"
     Application.DisplayAlerts = False
     ActiveWorkbook.SaveAs Filename:=Custom_name, FileFormat:=51
 End Sub

Я отключил переменную name, потому что она такая же, как fldrtitle.

В результате мой файл сохраняется рядом с созданная папка, как на картинке ниже:

Есть ли шанс сохранить ее ВНУТРИ этой папки?

Answer 1

Думаю, вы хотите это:

Function Createfolder() As String
  Dim fso As Object
  Dim fldrtitle As String
  Dim flrdrname As String
  Dim fldrpath As String

  Set fso = CreateObject("scripting.filesystemobject")
  fldrtitle = Worksheets("Sheet1").Range("A2").Value
  fldrname = "Pre-planning NBU " & fldrtitle
  fldrpath = "H:\ProfileV2\Desktop\Pre planning NBU\ Alex list new\" & fldrname
  If not fso.FolderExists(fldrpath) Then
      fso.Createfolder (fldrpath)
  End If

  Createfolder = fldrpath
End Function

Sub Save()

  Dim name As String, Custom_Name As String

  name = Worksheets("Sheet1").Range("A2").Value
  Custom_Name = Createfolder() & "\NBU " & name & " - Opportunity list.xlsx"
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=Custom_name, FileFormat:=51
End Sub

РЕДАКТИРОВАТЬ

На самом деле вы ничего не получаете, отделяя создание папки, это, вероятно, будет лучше:

Sub Save()

  Dim fso As Object
  Dim fldrtitle As String
  Dim flrdrname As String
  Dim fldrpath As String
  Dim filename As String
  Dim name As String

  'Construct folder name
  fldrtitle = Worksheets("Sheet1").Range("A2").Value
  name = Worksheets("Sheet1").Range("A2").Value 'looks like this is the same as fldrtitle, could just use same variable below
  fldrname = "Pre-planning NBU " & fldrtitle
  fldrpath = "H:\ProfileV2\Desktop\Pre planning NBU\ Alex list new\" & fldrname

  'Create folder if it doesn't exist
  Set fso = CreateObject("scripting.filesystemobject")
  If not fso.FolderExists(fldrpath) Then
      fso.Createfolder (fldrpath)
  End If

  'Construct filename and save
  filename = fldrpath & "\NBU " & name & " - Opportunity list.xlsx"
  Application.DisplayAlerts = False
  ActiveWorkbook.SaveAs Filename:=filename, FileFormat:=51
End Sub