Nick72310
01-07-2016, 11:09 AM
I am trying to save a file in a folder using macro, but I want to create a new folder if the folder does not already exist. If it does exist, I want it to save in the proper folder.
The folder names are based off of the date... In my spreadsheet I have code that generates todays date when the document is opened. I want the new created folders to be the year, followed by the word Quotes (ie. 2016 Quotes). So throughout the year of 2016, I want all the files to be saved in folder 2016 Quotes. But as soon as 2017 comes around, I want a new folder to automatically be created (2017 Quotes) and the file should be saved there.
The file name is based off of the value in "Sheets("BOM & Routing (IE)").Range("N3")". (This cell is formatted as Text)
The directory is based off of the date in "Sheets("BOM & Routing (IE)").Range("G5")". Where G5 is the date in the format of "mm/dd/yy". But I only want the year to be present in the folder name.
My code is shown below. I have also attached a file to make it easier. The sheet is password protected. The password is IE.
Thank you in advance!
15122
Sub Auto_open()
On Error Resume Next
With Worksheets("BOM & Routing (IE)")
.Unprotect Password:="IE"
.Protect Password:="IE", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
userInterfaceOnly:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=True, _
AllowSorting:=False, _
AllowFiltering:=False, _
AllowUsingPivotTables:=False
With .Range("G5")
If IsEmpty(.Value) Then
.Value = Date
.NumberFormat = "mm/dd/yy"
End If
End With
Application.Goto .Range("G4")
End With
End Sub
Function DirectoryExist(sstr As String)
Dim lngAttr As Long
DirectoryExist = False
If Dir(sstr, vbDirectory) <> "" Then
lngAttr = GetAttr(sstr)
If lngAttr And vbDirectory Then _
DirectoryExist = True
End If
End Function
Sub Test()
Dim dirstr As String
dirstr = "C:\Users\Nick72310\Desktop\" & Sheets("BOM & Routing (IE)").Range("G5").Value & " Quotes"
If Not DirectoryExist(dirstr) Then
MkDir dirstr
ActiveWorkbook.SaveAs _
dirstr & Sheets("BOM & Routing (IE)").Range("N3") & ".xlsm", FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
ActiveWorkbook.SaveAs Filename:= _
dirstr & Sheets("BOM & Routing (IE)").Range("N3") & ".xlsm", FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
End Sub
The folder names are based off of the date... In my spreadsheet I have code that generates todays date when the document is opened. I want the new created folders to be the year, followed by the word Quotes (ie. 2016 Quotes). So throughout the year of 2016, I want all the files to be saved in folder 2016 Quotes. But as soon as 2017 comes around, I want a new folder to automatically be created (2017 Quotes) and the file should be saved there.
The file name is based off of the value in "Sheets("BOM & Routing (IE)").Range("N3")". (This cell is formatted as Text)
The directory is based off of the date in "Sheets("BOM & Routing (IE)").Range("G5")". Where G5 is the date in the format of "mm/dd/yy". But I only want the year to be present in the folder name.
My code is shown below. I have also attached a file to make it easier. The sheet is password protected. The password is IE.
Thank you in advance!
15122
Sub Auto_open()
On Error Resume Next
With Worksheets("BOM & Routing (IE)")
.Unprotect Password:="IE"
.Protect Password:="IE", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
userInterfaceOnly:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=True, _
AllowSorting:=False, _
AllowFiltering:=False, _
AllowUsingPivotTables:=False
With .Range("G5")
If IsEmpty(.Value) Then
.Value = Date
.NumberFormat = "mm/dd/yy"
End If
End With
Application.Goto .Range("G4")
End With
End Sub
Function DirectoryExist(sstr As String)
Dim lngAttr As Long
DirectoryExist = False
If Dir(sstr, vbDirectory) <> "" Then
lngAttr = GetAttr(sstr)
If lngAttr And vbDirectory Then _
DirectoryExist = True
End If
End Function
Sub Test()
Dim dirstr As String
dirstr = "C:\Users\Nick72310\Desktop\" & Sheets("BOM & Routing (IE)").Range("G5").Value & " Quotes"
If Not DirectoryExist(dirstr) Then
MkDir dirstr
ActiveWorkbook.SaveAs _
dirstr & Sheets("BOM & Routing (IE)").Range("N3") & ".xlsm", FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Else
ActiveWorkbook.SaveAs Filename:= _
dirstr & Sheets("BOM & Routing (IE)").Range("N3") & ".xlsm", FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
End Sub