[RESOLVED] how to create a monthly folder automatically

[ontro]

I have a monthly function here.

What would it be like to create a folder for each month?
I mean end of the month create a new folder

day 31-01-2024 create a new folder that says 01-02-2024

Private Function SetDates (pDate As Date) As String
 Select Case Month (pDate)
  Case 1, 3, 5, 7, 8, 10, 12
   SetDates = “31”
  Case 4, 6, 9, 11
   SetDates = “30”
  Case 2
   If (Year(pDate) Mod 4) = 0 Then
    SetDates = “29”
   Else
    SetDates = “28”
   End If
 End Select
End Function

thank you

[Arnoutdv]

Just an idea:

' Return a foldername DD-MM-YYYY if the given date is the last day of the month
' otherwise return ""
Private Function pFolderName(ByVal lDate As Long) As String
  If pIsLastDayOfMonth(lDate) Then pFolderName = Format(lDate + 1, "DD\-MM\-YYYY")
End Function

' Check if the given date is the last day of the month
Private Function pIsLastDayOfMonth(ByVal lDate As Long) As Boolean
  pIsLastDayOfMonth = (Day(lDate + 1) = 1)
End Function

[ontro]

thank you

to activate the functions as would be

thank you

[ontro]

' Return a foldername DD-MM-YYYY if the given date is the last day of the month
' otherwise return ""
Private Function pFolderName(ByVal lDate As Long) As String
  If pIsLastDayOfMonth(lDate) Then pFolderName = Format(lDate + 1, "DD\-MM\-YYYY")
End Function

' Check if the given date is the last day of the month
Private Function pIsLastDayOfMonth(ByVal lDate As Long) As Boolean
  pIsLastDayOfMonth = (Day(lDate + 1) = 1)
End Function



to create a folder



Private Sub Command1_Click()
Dim createfolder As Object
Dim name As String
Dim route As String

route = App.Path & "\"
name = InputBox("enter the name of a folder", "folder name")

Set createfolder = CreateObject("scripting.filesystemobject")
createfolder.createfolder route & name

MsgBox "Your folder has been created successfully", vbInformation, "created folder"

End Sub

How to make the two functions work to make a folder

day 31-01-2024 create a new folder that says 01-02-2024

thank you

[VanGoghGaming]

This code adds one day to the current date:

DateAdd("d", 1, Date)

Then you can make a folder with "MkDir". Can you put them together?

[Elroy]

Just as a tip, the easiest way to get the "last day of the month" is to create a date that's the first day of the next month, and then subtract one (day). That way, you let Windows (or VB6) deal with all the leap year stuff and how many days in each month.

And just in case you didn't get MSDN installed. Here are most of the relevant VB6 functions you'll need:

• DateValue
• DateSerial
• DateDiff
• DateAdd
• Year
• Month
• Day

[ontro]

hello

I need the first day of each month and year

I mean


01-01-2024 create folder

01-02-2024 create folder

01-03-2024 create folder


01.04-2024 create folder

etc,etc

thank you

[Elroy]

hello

I need the first day of each month and year

I mean


01-01-2024 create folder

01-02-2024 create folder

01-03-2024 create folder


01.04-2024 create folder

etc,etc

thank you

So, what problem are you having doing that?

[Zvoni]

Just as a tip, the easiest way to get the "last day of the month" is to create a date that's the first day of the next month, and then subtract one (day). That way, you let Windows (or VB6) deal with all the leap year stuff and how many days in each month.

Or look in Codebank, since we had a "new" LastDayOfMonth just a few weeks ago.

Or you just use DateSerial on the "zero"-th Day of the following month....

    Debug.Print DateSerial(2024, 6, 0)

Returns: 2024-05-31

And nevermind OP should use ISO-Format for the Foldernames.... "YYYY-MM-DD Blablab"
Otherwise he'll get a surprise when sorting the Foldernames...

btw: Why not just create all Folders for the Year in one go, and be done with it? No need for checking if it's the last Day of the Month and whatnot

And instead of MkDir and/or using FSO, i'd rather go for SHCreateFolderExW-API, since that one uses absolute paths and creates any missing intermediate Folders, too
If the Folder already exists, it's a No-Op

[ChrisE]

btw: Why not just create all Folders for the Year in one go, and be done with it? No need for checking if it's the last Day of the Month and whatnot

thats what I would also do

@ontro
here a sample you can adjust to your needs

Option Explicit

Private Sub Command1_Click()
  Dim nYear As Long
        Dim nMonth As Long
        Dim nDays As Long
        Dim LastDayOfMonth As Date
        Dim FirstDayOfMonth As Date
        Dim d As Date
        
        
        For nYear = 2024 To 2026 'set Year or Years to create Folders
            For nMonth = 1 To 12
               
                LastDayOfMonth = DateSerial(nYear, nMonth + 1, 0)
                FirstDayOfMonth = DateSerial(nYear, nMonth, 1)
                
                'get a Day count in that month
                d = DateSerial(nYear, nMonth, 1)
                nDays = Day(DateAdd("m", 1, d) - 1)
            
                List1.AddItem ("First Day Of Month : " & Format(FirstDayOfMonth, "dddd dd.MM.yyyy"))
                List1.AddItem ("Days in Month : " & nDays)
                List1.AddItem ("Last Day of Month  : " & Format(LastDayOfMonth, "dddd dd.MM.yyyy"))
                List1.AddItem ("---------------------------------------------------------------------")

     FolderCreateNew "E:\TestFolder\Reports\" & nYear & "\" & Format(FirstDayOfMonth, "dd-MM-yyyy") & "  " & Format(LastDayOfMonth, "dd-MM-yyyy"), True
'create folders like:
'E:\TestFolder\Reports\2024\01-01-2024 31-01-2024
'E:\TestFolder\Reports\2024\01-02-2024 29-02-2024
'etc...


            Next nMonth
        Next nYear
End Sub

Public Function FolderCreateNew(Path As String, _
                             Optional ShowError As Boolean = True) As Boolean
   Dim s As String
   Dim s1() As String
   Dim s2 As String
   Dim Titel As String
   Dim i As Long
   
      Titel = "FolderCreate"
   
      
      If Len(Trim(Path)) = 0 Then
         If ShowError Then
            yourError 1, "no path text", Titel
         End If
         Exit Function
      End If
      s = Replace(Trim(Path), "\\", "\")
      'remove last BackSlash
      If Right(s, 1) = "\" Then
         s = Left$(s, Len(s) - 1)
      End If
      
      'split into Folders
      s1() = Split(s, "\")
      
      'does the Path exist
      s2 = Join(s1(), "\")
      If Len(Dir(s2, vbDirectory)) > 0 Then
         If ShowError Then
            yourError 2, "Path " & Path & vbCrLf & _
                          "exist allready", Titel
         End If
         Exit Function
      End If
      
      s2 = s1(LBound(s1))
      'check for Drive
      If Len(Dir(s2)) = 0 Then
         If ShowError Then
            yourError 3, "Drive " & s2 & " not found !", Titel
         End If
         Exit Function
      End If
      
      'check the Path(s)
      On Error GoTo Fehler
      For i = LBound(s1) + 1 To UBound(s1)
         s2 = s2 & "\" & s1(i)
         If Len(Dir(s2, vbDirectory)) = 0 Then
            'Folder doesn't exsit, so create it
            MkDir s2
         End If
      Next
      FolderCreateNew = True
      Exit Function
Fehler:
      If ShowError Then
         yourError err.Number, err.Description, Titel
      End If
End Function

Public Sub yourError(ErrNumber As Long, ErrDescription As String, _
                         Optional Titel As String = "")

   Dim Msg As String
   
      Msg = "Error " & ErrNumber & vbCrLf & vbCrLf & _
            ErrDescription
      MsgBox Msg, vbCritical, Titel
End Sub

[Zvoni]

thats what I would also do

@ontro
here a sample you can adjust to your needs

Option Explicit

Private Sub Command1_Click()
  Dim nYear As Long
        Dim nMonth As Long
        Dim nDays As Long
        Dim LastDayOfMonth As Date
        Dim FirstDayOfMonth As Date
        Dim d As Date
        
        
        For nYear = 2024 To 2026 'set Year or Years to create Folders
            For nMonth = 1 To 12
               
                LastDayOfMonth = DateSerial(nYear, nMonth + 1, 0)
                FirstDayOfMonth = DateSerial(nYear, nMonth, 1)
                
                'get a Day count in that month
                d = DateSerial(nYear, nMonth, 1)
                nDays = Day(DateAdd("m", 1, d) - 1)
            
                List1.AddItem ("First Day Of Month : " & Format(FirstDayOfMonth, "dddd dd.MM.yyyy"))
                List1.AddItem ("Days in Month : " & nDays)
                List1.AddItem ("Last Day of Month  : " & Format(LastDayOfMonth, "dddd dd.MM.yyyy"))
                List1.AddItem ("---------------------------------------------------------------------")

     FolderCreateNew "E:\TestFolder\Reports\" & nYear & "\" & Format(FirstDayOfMonth, "dd-MM-yyyy") & "  " & Format(LastDayOfMonth, "dd-MM-yyyy"), True
'create folders like:
'E:\TestFolder\Reports\2024\01-01-2024 31-01-2024
'E:\TestFolder\Reports\2024\01-02-2024 29-02-2024
'etc...


            Next nMonth
        Next nYear
End Sub

Public Function FolderCreateNew(Path As String, _
                             Optional ShowError As Boolean = True) As Boolean
   Dim s As String
   Dim s1() As String
   Dim s2 As String
   Dim Titel As String
   Dim i As Long
   
      Titel = "FolderCreate"
   
      
      If Len(Trim(Path)) = 0 Then
         If ShowError Then
            yourError 1, "no path text", Titel
         End If
         Exit Function
      End If
      s = Replace(Trim(Path), "\\", "\")
      'remove last BackSlash
      If Right(s, 1) = "\" Then
         s = Left$(s, Len(s) - 1)
      End If
      
      'split into Folders
      s1() = Split(s, "\")
      
      'does the Path exist
      s2 = Join(s1(), "\")
      If Len(Dir(s2, vbDirectory)) > 0 Then
         If ShowError Then
            yourError 2, "Path " & Path & vbCrLf & _
                          "exist allready", Titel
         End If
         Exit Function
      End If
      
      s2 = s1(LBound(s1))
      'check for Drive
      If Len(Dir(s2)) = 0 Then
         If ShowError Then
            yourError 3, "Drive " & s2 & " not found !", Titel
         End If
         Exit Function
      End If
      
      'check the Path(s)
      On Error GoTo Fehler
      For i = LBound(s1) + 1 To UBound(s1)
         s2 = s2 & "\" & s1(i)
         If Len(Dir(s2, vbDirectory)) = 0 Then
            'Folder doesn't exsit, so create it
            MkDir s2
         End If
      Next
      FolderCreateNew = True
      Exit Function
Fehler:
      If ShowError Then
         yourError err.Number, err.Description, Titel
      End If
End Function

Public Sub yourError(ErrNumber As Long, ErrDescription As String, _
                         Optional Titel As String = "")

   Dim Msg As String
   
      Msg = "Error " & ErrNumber & vbCrLf & vbCrLf & _
            ErrDescription
      MsgBox Msg, vbCritical, Titel
End Sub

No need for this convoluted CreateFolder-Function:
https://learn.microsoft.com/en-us/wi...tedirectoryexw

[ChrisE]

@Zvoni
just show your example, Ontro would have two samples to choose from

[ontro]

okay
now it's fine
I just need to make folders for each day within each month's folder.
thank you

[Zvoni]

@Zvoni
just show your example, Ontro would have two samples to choose from

Can't. No vb6 available, only Office-VBA 64-Bit.
My "Solution" is more like "from the top of my head, what i can remember"

[Arnoutdv]

okay
now it's fine
I just need to make folders for each day within each month's folder.
thank you

Maybe you should start your new threads with clear description of your needs.
In this thread after each given answer you come up with additional requirements.

It seems that you just want to create an hierarchical folder structure based on months and days.
And the top level folders need to be YYYY-MM-01 and the subfolders need to be per day.

I would create folders per year, in the year folder have folders for the 12 months and per month create a folder per day.

+2024
  + 01
     + 01
     + 02
     ..
     + 28
     + 29
     + 30
     + 31
  + 02
     ..
  + 03
  ..
  + 12

[Zvoni]

Maybe you should start your new threads with clear description of your needs.
In this thread after each given answer you come up with additional requirements.

It seems that you just want to create an hierarchical folder structure based on months and days.
And the top level folders need to be YYYY-MM-01 and the subfolders need to be per day.

Any bets, that the next question is going to be "How to find out, if it's a Leap Year"?

[ChrisE]

okay
now it's fine
I just need to make folders for each day within each month's folder.
thank you

you allready have a count of the Days in each month, you need to create another loop for each Day-Folder 01..02 etc..

'...
                'get a Day count in that month
                d = DateSerial(nYear, nMonth, 1)
                nDays = Day(DateAdd("m", 1, d) - 1)
            
                List1.AddItem ("First Day Of Month : " & Format(FirstDayOfMonth, "dddd dd.MM.yyyy"))
                List1.AddItem ("Days in Month : " & nDays)
'....

hope you are not going into Hours and then .....

[ontro]

I try to do this but it doesn't work

Dim nYear As Long
        Dim nMonth As Long
        Dim nDays As Long
        Dim LastDayOfMonth As Date
        Dim FirstDayOfMonth As Date
        Dim d As Date
        Dim lor As Long
        nDays = 31
        For nYear = 2024 To 2026
            For nMonth = 1 To 12
              For lor = 1 To nDays
                LastDayOfMonth = DateSerial(nYear, nMonth + 1, 0)
                FirstDayOfMonth = DateSerial(nYear, nMonth, 1)
                d = DateSerial(nYear, nMonth, 1)
                nDays = Day(DateAdd("m", 1, d) - 1)
            
            

     FolderCreateNew App.Path & "\" & nYear & "\" & Format(FirstDayOfMonth, "dd-MM-yyyy") & "  " & Format(LastDayOfMonth, "dd-MM-yyyy"), True & "\" & lor



               Next lor
            Next nMonth
        Next nYear

[Arnoutdv]

The code inside inner loop is not correct
nDays is calculated inside the loop, but you are using it as the "To" in the for loop
Also the call to FolderCreateNew seems not correct

For lor = 1 To nDays
  LastDayOfMonth = DateSerial(nYear, nMonth + 1, 0)
  FirstDayOfMonth = DateSerial(nYear, nMonth, 1)
  d = DateSerial(nYear, nMonth, 1)
  nDays = Day(DateAdd("m", 1, d) - 1)
  FolderCreateNew App.Path & "\" & nYear & "\" & Format(FirstDayOfMonth, "dd-MM-yyyy") & "  " & Format(LastDayOfMonth, "dd-MM-yyyy"), True & "\" & lor
Next lor

Do you want the following structure?:

+2024
  +01-01-2024  31-01-2024
     +1
     +2
     ..
     +31

Can you please show an example of the output you want?
A folder with the name "01-01-2024 31-01-2024" will be hard to access programmatically.

[ontro]

correct
So what would an example with code be like?
thank you

[Arnoutdv]

Option Explicit

Private Declare Function SHCreateDirectoryExW Lib "SHELL32.dll" (ByVal hwnd As Long, ByVal pszPath As Long, ByRef psa As Any) As Long

Private Sub Form_Load()
  Dim lYear As Long, lMonth As Long, lDay As Long
  Dim lLastDay As Long
  Dim sYearFolder As String, sMonthFolder As String, sFolder As String
  
  For lYear = 2024 To 2026
    sYearFolder = App.Path & "\" & CStr(lYear)
    CreateFolder sYearFolder
    For lMonth = 1 To 12
      lLastDay = Day(DateSerial(lYear, lMonth + 1, 0))
      sMonthFolder = sYearFolder & "\" & Format(DateSerial(lYear, lMonth, 1), "DD\-MM\-YYYY") & "  " & Format(DateSerial(lYear, lMonth, lLastDay), "DD\-MM\-YYYY")
      CreateFolder sMonthFolder
      For lDay = 1 To lLastDay
        sFolder = sMonthFolder & "\" & CStr(lDay)
        CreateFolder sFolder
      Next lDay
    Next lMonth
  Next lYear
End Sub

Private Sub CreateFolder(sFolder As String)
  Debug.Print sFolder
  SHCreateDirectoryExW 0, StrPtr(sFolder), Nothing
End Sub

[ontro]

resolved

thank you so much

[ontro]

to get full path to save data in sequential file

lYear lMonth lDay


thank you

[Arnoutdv]

How to get these variables from a date variable?
Check the help more often. It’s as simple as using Year(), Month() and Day()

[Zvoni]

to get full path to save data in sequential file

lYear lMonth lDay


thank you

Is there a question somewhere i can't see?

[ontro]

In the month variable I get month 5 and it should come out 05-01-2024 05-31-2024

code

 


Dim route As String
    route = App.Path & "\" & Year(Now) & "\" & Month(Now) & "\" & Day(Now) & "\" & (nom + ".txt")

thank you

[ontro]

]n the month variable I get month 5 and it should come out 01-05-2024 31-05-2024

Dim route As String
    route = App.Path & "\" & Year(Now) & "\" & Month(Now) & "\" & Day(Now) & "\" & (nom + ".txt")

[Arnoutdv]

All the code for creating the folder name is post #21

[ontro]

this path is to save the data
in the month(now) variable it reads month 5
but it has to leave 05-01-2024 05-31-2024
and it doesn't come out

Dim route As String
    route = App.Path & "\" & Year(Now) & "\" & Month(Now) & "\" & Day(Now) & "\" & (nom + ".txt")

[Arnoutdv]

The code for defining the folder is in post 21
Read it, take the folder building string code and use it.

I give up..

[ontro]

I give up

thank you so much

[VanGoghGaming]

It's the international giving up day!

[ontro]

I need the current date of:

sMonthFolder = sYearFolder & "\" & Format(DateSerial(lYear, lMonth, 1), "DD\-MM\-YYYY") & "  " & Format(DateSerial(lYear, lMonth, lLastDay), "DD\-MM\-YYYY"

to search

Dim route As String
    route = App.Path & "\" & Year(Now) & "\" & sMonthFolder & "\" & Day(Now) & "\" & (nom + ".txt

thank you