VBA Code simplification - Creating folder with month/year

davie1982

Board Regular
Joined
Nov 19, 2007
Messages
170
Office Version
365, 2019
Hi all

I have some long code here that I want to try and simplify/shorten, if possible. It's attached to a button on one of my forms. The code works great as it is though. Any suggestion?
It checks if a directory exists before moving a spreadsheet and adding the date at the end of it before the extension, and creates the directory based on the month and year.

Code:
Private Sub Command54_Click()
On Error Resume Next
DoCmd.SetWarnings False
Dim da As String
Dim mo As String
Dim ye As String
Dim mo1 As String
Dim mo2 As String
Dim mo3 As String
Dim mo4 As String
Dim mo5 As String
Dim mo6 As String
Dim mo7 As String
Dim mo8 As String
Dim mo9 As String
Dim mo10 As String
Dim mo11 As String
Dim mo12 As String
Dim zDir As String
mo1 = "January"
mo2 = "February"
mo3 = "March"
mo4 = "April"
mo5 = "May"
mo6 = "June"
mo7 = "July"
mo8 = "August"
mo9 = "September"
mo10 = "October"
mo11 = "November"
mo12 = "December"

Select Case Month(Date)
Case 1
zDir = mo1 & " " & Year(Date)
Case 2
zDir = mo2 & " " & Year(Date)
Case 3
zDir = mo3 & " " & Year(Date)
Case 4
zDir = mo4 & " " & Year(Date)
Case 5
zDir = mo5 & " " & Year(Date)
Case 6
zDir = mo6 & " " & Year(Date)
Case 7
zDir = mo7 & " " & Year(Date)
Case 8
zDir = mo8 & " " & Year(Date)
Case 9
zDir = mo9 & " " & Year(Date)
Case 10
zDir = mo10 & " " & Year(Date)
Case 11
zDir = mo11 & " " & Year(Date)
Case 12
zDir = mo12 & " " & Year(Date)
End Select
If Len(Day(Date)) = 1 Then da = "0" & Day(Date) Else da = Day(Date)
If Len(Month(Date)) = 1 Then mo = "0" & Month(Date) Else mo = Month(Date)
ye = Year(Date)

If Len(Dir("\\networkpath1\Zapper\" & zDir, vbDirectory)) = 0 Then
MkDir "\\networkpath1\Zapper\" & zDir
End If
DoCmd.OpenQuery "Q1-ManualImport"
Name "\\networkpath1\Zapper\spreadsheet.xlsx" As "\\networkpath1\Zapper\" & zDir & "\spreadsheet" & ye & mo & da & ".xlsx"
DoCmd.SetWarnings True
End Sub
 
Last edited:

Some videos you may like

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
983
Office Version
2007
Platform
Windows
Hi there. This should work: (changes in red)

Code:
Private Sub Command54_Click()
On Error Resume Next
DoCmd.SetWarnings False
[COLOR=#ff0000]Dim yemoda As String[/COLOR]
Dim zDir As String

[COLOR=#ff0000]zDir = Format(Date, "mmmm yy")

yemoda = Format(Date, "yymmdd")[/COLOR]

If Len(Dir("\\networkpath1\Zapper\" & zDir, vbDirectory)) = 0 Then
MkDir "\\networkpath1\Zapper\" & zDir
End If
DoCmd.OpenQuery "Q1-ManualImport"
Name "\\networkpath1\Zapper\spreadsheet.xlsx" As "\\networkpath1\Zapper\" & zDir & "\spreadsheet" & [COLOR=#ff0000]yemoda[/COLOR] & ".xlsx"
DoCmd.SetWarnings True
End Sub
 
Last edited:

xenou

MrExcel MVP, Moderator
Joined
Mar 2, 2007
Messages
16,676
Office Version
2013
Platform
Windows
As a note, consider using yyyy-mm as your format for directories (i.e., 2019-01,2019-02, etc.) which has the advantage of maintaining order across months and years (and makes it easier to sort and search, in my opinion, although I hardly ever finding anyone doing things this way - I guess that's life).
 

davie1982

Board Regular
Joined
Nov 19, 2007
Messages
170
Office Version
365, 2019
Thank you for help/advice.

I should've thought about the format() function earlier but I just couldn't think of it.

Thanks
:>
 

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
983
Office Version
2007
Platform
Windows
You're welcome and thanks for the feedback.
 

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
983
Office Version
2007
Platform
Windows
BTW, I have to agree with xenou - using dates in a sortable/searchable year,month,day format is a good way to go - like him, I don't see it often, and in fact a couple of my colleagues really struggle to understand that e.g. 20190711 is 11th September 2019!!
 

davie1982

Board Regular
Joined
Nov 19, 2007
Messages
170
Office Version
365, 2019
Hi, yes, that's how i'm currently organising my spreadsheets (all created through access) and it's quite helpful! Everything is nice and easy to find, which is nice especially when you get requests or queries.
 

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
983
Office Version
2007
Platform
Windows
oops!! Of course I should have said July!!!!!! No wonder they didn't get it! :LOL:
 

Watch MrExcel Video

Forum statistics

Threads
1,102,678
Messages
5,488,223
Members
407,632
Latest member
varunwalla

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top