Поиск каталога, создающего его, когда он не существует

Я пытаюсь создать макрос в excel, который удаляет всю информацию в рабочей области и создает новый файл (один для информации о новой неделе). Задача кажется мне довольно простой, но по какой-то причине моя часть обнаружения и создания каталога кода возвращает «что-то не так» msgbox, который я добавил, чтобы указать, что ни одно из условий не выполняется. Я проверил правописание и расположение каталогов в заявлении, и все кажется правильным. Мне просто нужен свежий набор глаз, потому что я уверен, что в этот момент мне не хватает чего-то очевидного.

Sub DerpDate() '-------------------------------------------------------------------------------------------------- 'Subroutine that creates necessary directories, places new workbook in those directories and clears 'out old data before terminating '-------------------------------------------------------------------------------------------------- '-------------------------------------------------------------------------------------------------- ' Declarations '-------------------------------------------------------------------------------------------------- Dim NxtWk As Range, YrFind As Range, MonFind As Range, MonName As Range, _ LngName As String, DerpName As String, DelProd As Range, DelMold As Range, ProdSheet As Sheets, _ MoldSheet As Sheets, WindSheets As Sheets Set NxtWk = Sheets("Data").Range("B53") Set YrFind = Sheets("Data").Range("C53") Set MonFind = Sheets("Data").Range("D53") Set MonName = Sheets("Data").Range("E53") LngName = MonFind.Value & "-" & MonName.Value & "-" & YrFind.Value DerpName = "\\Jupiter\Production\2 Production Schedules\" 'Production Ranges Set DelProd = Application.Union( _ Sheets("Production Schedule").Range("H5:AB9"), Sheets("Production Schedule").Range("H15:AB23"), _ Sheets("Production Schedule").Range("H29:AB30"), Sheets("Production Schedule").Range("H36:AB39"), _ Sheets("Production Schedule").Range("H45:AB54"), Sheets("Production Schedule").Range("H60:AB62"), _ Sheets("Production Schedule").Range("H68:AB73"), Sheets("Production Schedule").Range("H79:AB84"), _ Sheets("Production Schedule").Range("H90:AB94"), Sheets("Production Schedule").Range("H100:AB101"), _ Sheets("Production Schedule").Range("H107:AB112"), Sheets("Production Schedule").Range("H118:AB119"), _ Sheets("Production Schedule").Range("H125:AB126"), Sheets("Production Schedule").Range("H132:AB133"), _ Sheets("Production Schedule").Range("H139:AB140"), Sheets("Production Schedule").Range("H146:AB147"), _ Sheets("Production Schedule").Range("H153:AB156"), Sheets("Production Schedule").Range("H162:AB166"), _ Sheets("Production Schedule").Range("H172:AB175"), Sheets("Production Schedule").Range("H181:AB185"), _ Sheets("Production Schedule").Range("H186:AB186"), Sheets("Production Schedule").Range("H192:AB193")) 'Molding Ranges Set DelMold = Application.Union( _ Sheets("Molders").Range("B5:W8"), Sheets("Molders").Range("B14:W20"), _ Sheets("Molders").Range("B26:W31"), Sheets("Molders").Range("B37:W38"), Sheets("Molders").Range("B44:W45"), _ Sheets("Molders").Range("B51:W54"), Sheets("Molders").Range("B60:W63"), Sheets("Molders").Range("B69:W72"), _ Sheets("Molders").Range("C78:W93")) 'Winding Ranges Set DelWind = Application.Union( _ Sheets("Winders").Range("H5:AB6"), Sheets("Winders").Range("H8:AB9"), Sheets("Winders").Range("H11:AB12"), _ Sheets("Winders").Range("H14:AB15"), Sheets("Winders").Range("H17:AB18"), Sheets("Winders").Range("H20:AB21"), _ Sheets("Winders").Range("H23:AB24"), Sheets("Winders").Range("H26:AB27"), Sheets("Winders").Range("H29:AB30"), _ Sheets("Winders").Range("H32:AB33"), Sheets("Winders").Range("H35:AB36"), Sheets("Winders").Range("H38:AB39"), _ Sheets("Winders").Range("H41:AB42"), Sheets("Winders").Range("H44:AB45"), Sheets("Winders").Range("H47:AB48"), _ Sheets("Winders").Range("H50:AB51"), Sheets("Winders").Range("H53:AB54")) '-------------------------------------------------------------------------------------------------- 'Booleans to determine what (if any) directories need to be created before a new workbook can be 'created '-------------------------------------------------------------------------------------------------- 'See if the Year AND Month folder exist yet--save the new spreadsheet If Dir(DerpName & YrFind.Value & "\" & LngName) <> "" Then ActiveWorkbook.SaveAs Filename:=DerpName & YrFind.Value & "\" & LngName & "\" & NxtWk.Value & ".xlsm" 'If the Year AND Month Folder don't exist, see if just the Year folder does--create Month folder 'and save the new spreadsheet in it ElseIf Dir(DerpName & YrFind.Value) <> "" Then MkDir (DerpName & YrFind.Value & "\" & LngName) ActiveWorkbook.SaveAs Filename:=DerpName & YrFind.Value & "\" & LngName & "\" & NxtWk.Value & ".xlsm" 'If the Year and Month Folder don't exist, create Year and Month folder and save the 'new spreadsheet in it ElseIf Dir(DerpName) <> "" Then MkDir (DerpName & YrFind.Value) MkDir (DerpName & YrFind & "\" & LngName) ActiveWorkbook.SaveAs Filename:=DerpName & YrFind.Value & "\" & LngName & "\" & NxtWk.Value & ".xlsm" Else MsgBox ("Something is wrong with the file location operation in the DerpDate Subroutine") End If '-------------------------------------------------------------------------------------------------- 'Portion of the sub that removes old data from the new workbook '-------------------------------------------------------------------------------------------------- DelProd.ClearContents DelMold.ClearContents DelWind.ClearContents End Sub 

Спасибо за любую помощь, которую вы можете предложить!

EDIT: Я немного изменил ситуацию и прошел мимо моей оригинальной проблемы. С показанными изменениями я возвращаю ошибку доступа к пути / файлу (75).

 Dim NxtWk As Range, YrFind As Range, MonFind As Range, MonName As Range, _ LngName As String, DerpName As String, DelProd As Range, DelMold As Range, ProdSheet As Sheets, _ MoldSheet As Sheets, WindSheets As Sheets, MonDig As Range, DayDig As Range, FName As String Set NxtWk = Sheets("Data").Range("B53") Set YrFind = Sheets("Data").Range("C53") Set MonFind = Sheets("Data").Range("D53") Set MonName = Sheets("Data").Range("E53") LngName = MonFind.Value & "-" & MonName.Value & "-" & YrFind.Value DerpName = "\\Jupiter\ProductionSchedule\" & "2 Production Schedules" 'DerpName = "C:\user\dwallace\desktop" Set MonDig = Sheets("Data").Range("B59") Set DayDig = Sheets("Data").Range("C59") FName = MonDig.Value & "-" & DayDig.Value & "-" & YrFind.Value YrFold = YrFind.Value 'Production Ranges Set DelProd = Application.Union( _ Sheets("Production Schedule").Range("H5:AB9"), Sheets("Production Schedule").Range("H15:AB23"), _ Sheets("Production Schedule").Range("H29:AB30"), Sheets("Production Schedule").Range("H36:AB39"), _ Sheets("Production Schedule").Range("H45:AB54"), Sheets("Production Schedule").Range("H60:AB62"), _ Sheets("Production Schedule").Range("H68:AB73"), Sheets("Production Schedule").Range("H79:AB84"), _ Sheets("Production Schedule").Range("H90:AB94"), Sheets("Production Schedule").Range("H100:AB101"), _ Sheets("Production Schedule").Range("H107:AB112"), Sheets("Production Schedule").Range("H118:AB119"), _ Sheets("Production Schedule").Range("H125:AB126"), Sheets("Production Schedule").Range("H132:AB133"), _ Sheets("Production Schedule").Range("H139:AB140"), Sheets("Production Schedule").Range("H146:AB147"), _ Sheets("Production Schedule").Range("H153:AB156"), Sheets("Production Schedule").Range("H162:AB166"), _ Sheets("Production Schedule").Range("H172:AB175"), Sheets("Production Schedule").Range("H181:AB185"), _ Sheets("Production Schedule").Range("H186:AB186"), Sheets("Production Schedule").Range("H192:AB193")) 'Molding Ranges Set DelMold = Application.Union( _ Sheets("Molders").Range("B5:W8"), Sheets("Molders").Range("B14:W20"), _ Sheets("Molders").Range("B26:W31"), Sheets("Molders").Range("B37:W38"), Sheets("Molders").Range("B44:W45"), _ Sheets("Molders").Range("B51:W54"), Sheets("Molders").Range("B60:W63"), Sheets("Molders").Range("B69:W72"), _ Sheets("Molders").Range("C78:W93")) 'Winding Ranges Set DelWind = Application.Union( _ Sheets("Winders").Range("H5:AB6"), Sheets("Winders").Range("H8:AB9"), Sheets("Winders").Range("H11:AB12"), _ Sheets("Winders").Range("H14:AB15"), Sheets("Winders").Range("H17:AB18"), Sheets("Winders").Range("H20:AB21"), _ Sheets("Winders").Range("H23:AB24"), Sheets("Winders").Range("H26:AB27"), Sheets("Winders").Range("H29:AB30"), _ Sheets("Winders").Range("H32:AB33"), Sheets("Winders").Range("H35:AB36"), Sheets("Winders").Range("H38:AB39"), _ Sheets("Winders").Range("H41:AB42"), Sheets("Winders").Range("H44:AB45"), Sheets("Winders").Range("H47:AB48"), _ Sheets("Winders").Range("H50:AB51"), Sheets("Winders").Range("H53:AB54")) '-------------------------------------------------------------------------------------------------- 'Booleans to determine what (if any) directories need to be created before a new workbook can be 'created '-------------------------------------------------------------------------------------------------- ActiveWorkbook.Save 'See if a year directory exists. If it doesn't, create it, then create the month directory, then 'save the file. If Len(Dir(DerpName & "\" & YrFold)) = 0 Then MkDir (DerpName & "\" & YrFold) MkDir (DerpName & "\" & YrFold & "\" & LngName) ActiveWorkbook.SaveAs Filename:=DerpName & "\" & YrFold & "\" & LngName & "\" & FName & ".xlsm" 'Assuming the Year directory exists, see if the third one (Month) exists. If it doesnt, create it and 'save the file ElseIf Len(Dir(DerpName & "\" & YrFind & "\" & LngName)) = 0 Then MkDir DerpName & "\" & YrFold & "\" & LngName ActiveWorkbook.SaveAs Filename:=DerpName & "\" & YrFold & "\" & LngName & "\" & FName & ".xlsm" 'Assuming all necessary directories already exist, save the file Else ActiveWorkbook.SaveAs Filename:=DerpName & "\" & YrFold & "\" & LngName & "\" & FName & ".xlsm" End If '-------------------------------------------------------------------------------------------------- 'Portion of the sub that removes old data from the new workbook '-------------------------------------------------------------------------------------------------- DelProd.ClearContents DelMold.ClearContents DelWind.ClearContents End Sub 

Единственное, что я могу думать, это то, что это связано с тем, что я пытаюсь изменить общий сетевой каталог, и есть пользовательский параметр, который я не вижу.

    Для любого из вас, кто столкнулся с этой проблемой, я понял это с небольшим поиском по поисковым запросам на основе темы. MkDir не очень любит файловые пути UNC. Таким образом, независимо от того, что я пытался с форматированием и конкатенацией, это не сработало. Чтобы выполнить ту же работу с сетевым местоположением с UNC-адресами, вам потребуется отдельная функция API. Здесь я нашел отличную статью:

    http://www.devhut.net/2011/09/15/vba-create-directory-structurecreate-multiple-directories/

    Просто поместите API в отдельный модуль и вызовите его с файлом пути UNC в своем макросе. API:

     Public Sub MakeFullDir(strPath As String) If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Optional depending upon intent MakeSureDirectoryPathExists strPath End Sub 

    Пример макроса:

     Sub Example() Dim filepath As String filepath = "\\Server\Directory\SubDirectory\FolderYouWantToCreate" Call MakeFullDir(filepath) End Sub 

    API фактически заменяет Boolean и MkDir, поскольку он выполняет обе функции.

    Надеюсь, это поможет кому-то!

    Давайте будем гением компьютера.