# Create a folder and perform a SaveAs

I have this code that is working as intended. Since I am still learning VBA and coding, I was wondering if anyone could look at this at let me know if there is another way to write this. This is part of an Add-In I created and is used by several other people (meaning that I installed the Add-In onto their PCs).

Sub Ex()
If InStr(LCase$(ActiveWorkbook.name), "extract") > 0 Then Exit Sub Else Dim MyDir As String, fn As String MyDir = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\Extract Files" ' change this to valid path If Len(Dir(MyDir, vbDirectory)) = 0 Then MkDir MyDir fn = MyDir & "\Extract - " & Format(Now, "mm-dd-yyyy hh_mm") ActiveWorkbook.SaveAs Filename:=fn, FileFormat:=xlOpenXMLWorkbook End If End Sub  I had a problem with the code creating a new file each time the custom menu button (which is the trigger for the add-in and has other tools that are used on this workbook) was activated, so I added this to prevent that from occurring: If InStr(LCase$(ActiveWorkbook.name), "extract") > 0 Then
Exit Sub
Else


Please let me know if there is any room for improvement of the way this is constructed.

You haven't mentioned exactly what triggers this code, but it might run on any open workbook, even if that workbook is confidential to the active user. You might want to consider checking if the activeworkbook is actually a workbook that you want to save. For example, you could check for a document property or a sheetname.

The InStr function can be case-insensitive, so you don't need to use the LCase statement

The FileSystemObject makes it easier to work with files and folders, than using MkDir and Dir.

The FileSystemObject has a BuildPath method that makes building paths easier than using concatenation and worrying about whether you need a backslash

Your function and variables were a little ambiguously named... Better to use names that have explicit meanings.

Your SaveAs file name uses mm-dd-yyyy format, but you'll probably be better off with yyyymmdd as your files will then sort alphabetically and chronologically (and it's an ISO standard)

Your SaveAs file name is missing a file extension. It's good practice to add an extension, even if your Explorer settings don't show them, as extensions help Windows to determine which application to use, and they help users identify the files they need to keep/discard.

 Sub ExtractFile()
'Add a reference to Microsoft Scripting Runtime
If InStr(1, ActiveWorkbook.Name, "extract", vbTextCompare) > 0 Then
Exit Sub
Else
Dim oFSO As Scripting.FileSystemObject
Dim folMyDocs As Scripting.Folder
Dim sExtractsPath As String
Dim sFilePath As String

Set oFSO = New Scripting.FileSystemObject
Set folMyDocs = oFSO.GetFolder(CreateObject("WScript.Shell").SpecialFolders("MyDocuments"))
sExtractsPath = oFSO.BuildPath(folMyDocs, "Extract Files")
If Not oFSO.FolderExists(sExtractsPath) Then
oFSO.CreateFolder sExtractsPath
End If
'sFilePath = oFSO.BuildPath(sExtractsPath, Format(Now, "mm-dd-yyyy hh_mm"))
sFilePath = oFSO.BuildPath(sExtractsPath, Format(Now, "yyyymmdd-hhmmss") & ".xlsx")
ActiveWorkbook.SaveAs Filename:=sFileName, FileFormat:=xlOpenXMLWorkbook
End If

End Sub

• Thank you for all the information and updates. I did not know about the ISO standard for formatting. Very useful. One question (just so I understand the code a little better) in regards to adding the extension, I thought that using the 'FileFormat:=xlOpenXMLWorkbook' automatically provided the required extension (.xlsx)? – Iron Man Jan 18 '16 at 17:47