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

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
979
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,670
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
979
Office Version
2007
Platform
Windows
You're welcome and thanks for the feedback.
 

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
979
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
979
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,260
Messages
5,485,723
Members
407,511
Latest member
Tryintouseexcel

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top