I'm trying to create a macro in excel that deletes all the information in the work area and creates a new file (one for a new week's worth of information). The task seems pretty straightforward to me but for some reason my directory discovery and creation portion of the code is returning the "something is wrong" msgbox I've added to indicate that none of the conditions are met. I've checked the spelling and location of the directories in the statement and everything seems to be correct. I just need a fresh set of eyes because I'm sure I'm missing something obvious at this point.
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
Thanks for any help you can offer!
EDIT: I've changed things around a bit and have gotten past my original issue. With the changes shown, I'm returning a Path/File access error (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
The only thing I can think is that this is being caused by the fact that I'm trying to change a shared network directory and there is a user setting I'm not seeing.
For any of you that encounter this issue, I figured it out with a bit of subject-based google searching. MkDir doesn't like UNC filepaths very much. As such, no matter what I tried with formatting and concatenation wouldn't work. In order to do the same job with a UNC-pathed network location, you need a separate API function. I found a great article on it here:
http://www.devhut.net/2011/09/15/vba-create-directory-structurecreate-multiple-directories/
Just place the API in a separate module and call it with your UNC filepath in your macro. The API:
Public Sub MakeFullDir(strPath As String)
If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Optional depending upon intent
MakeSureDirectoryPathExists strPath
End Sub
The macro example:
Sub Example()
Dim filepath As String
filepath = "\\Server\Directory\SubDirectory\FolderYouWantToCreate"
Call MakeFullDir(filepath)
End Sub
The API actually replaces the Boolean and the MkDir as it performs both functions.
Hope this helps someone!