ファイル振り分けのロジック

Question

###自動でテキストにTODOを書いて残しておきたいなあ
業務中にテキストファイルに今日あったことや備忘録として書き溜めて保存しています。
毎日作るのが面倒なのと、単にずっと書き溜めていくと、後から見るのが大変という理由で、
自動でそれらをさせたいなあと思い、軽い気持ちで始めました。

ところが振り分けをする際のロジックが意外と面倒でした。
自力で導き出したいのですが、
小1時間ほど悩み調べようか迷い、そして停止しました。

考え方のヒント等、教えていただけますか。。。
(別のコードでも大丈夫です。多分。）

###前提
・勤務日は 月曜日から金曜日 とします。この期間を 勤務日週 とします。
・勤務日週ごとにフォルダ分けする。
・勤務日毎 １ファイル 作成する。（タイムスケジューラでログイン時に実行させる。）
・ファイルは作成時、勤務日週ごとのフォルダに振り分けて格納する。
・休日出勤したらその日の分も作られる。（重要）
・土日とかをカウントとかはしたくない。
・数式的な解法でやってみたい。（アホだけど）

WindowsなのでVBSを使いました。なんか手軽だと思いました。

現在の状況

フォルダ内（直でいっぱいはいっている・・・）
C:\Users\hoge\Desktop\Note
20190301_hoge.txt ,20190304_hoge.txt ,20190305_hoge.txt ...
.
.
.
20190320_hoge.txt ,20190322_hoge.txt ,20190325_hoge.txt ,20190326_hoge.txt ...

###実現したいこと
以下のようにテキストファイルをファイルを振り分けたい
例えば今月の1日からフォルダ分けしてみる場合、以下の様な、振り分け方になると思います。

1.３月分フォルダを作成（月ごとにわける）

C:\Users\hoge\Desktop\Note\201903

2.３月分フォルダ以下に勤務日週ごとのフォルダを作成し、格納する。

１週目　（金曜日のみなので１ファイル分入るはず）
C:\Users\hoge\Desktop\Note\201903\Week1
　20190301_hoge.txt 

２週目　（５ファイル分入るはず）
C:\Users\hoge\Desktop\Note\201903\Week2
　20190304_hoge.txt ,20190305_hoge.txt ,20190306_hoge.txt ...

３週目（５ファイル分入るはず）
C:\Users\hoge\Desktop\Note\201903\Week3
　勤務日分毎日ここにはいる

４週目（４ファイル分入るはず）
C:\Users\hoge\Desktop\Note\201903\Week4
　今月祝日はもちろんはいらない

５週目（今日分含んで２ファイル）
C:\Users\hoge\Desktop\Note\201903\Week5
　20190325_hoge.txt ,20190326_hoge.txt

###考えたこと・試したこと
とりあえず、思考停止してしまったコードです・・・

Option Explicit

Public Sub main hoge()

    Dim today
    Dim wkFolderName '週ごとのフォルダ名

    today = Date()

    'とりあえず、これができればニッコリして寝れる
    '振り分け先のフォルダ名がここで取れれば良い　ex) Week1, Week2, Week3 ...
    wkFolderName = getFuriwakeWeekName(today) 

　　Call Msgbox("振り分け先は" & wkFolderName & "です。", vbInformation, "Todo振り分け先の確認")

End Sub

'引数は今日として分ける先のフォルダ名を判定する
Private Function getFuriwakeWeekName(today)
    'return any one of Week1, Week2, Week3, Week4, Week5 (Week6) ...
    
    Dim firstday '当月初めの日付
    Dim weekday '曜日    
    
    firstday = DateSerial(Year(Date()), Month(Date()), 1)
    'なんか、日曜日は１で始まるインデックスが返る関数があった。
    '今月は金曜日（=5）から始まったらしい
    weekday = weekday(firstday)
    
    '月初が土であり、作成した場合、次週はweek2
    '月初が日曜日であれば、次週はweek1
    '月初がそれ以外であれば、次週はweek2
    '
    '返ってくるインデックス
    '日⇒土
    '1 2 3 4 5 6
    '
    '月の始まりが金曜日
    '１週目の１日目
    'weekday = weekday(firstday) ⇒　5?（金曜日）
    '今日が26日
    '今日は５週目の２日目
    'weekday = weekday(today) ⇒　3?（火曜日）

    'getFuriwakeWeekName = "Week" & CStr(　　)

End Function

Comments

[y_waiwai]

なにがわからないのでしょうか
聞きたいことをはっきりさせましょう

[hrksh]

今日の日付はカレンダー上で第何週目か　
を判定するロジックがわかりません。よろしくおねがいします。

[ttyp03]

質問本文長々と書いて、聞きたいことはそれだけかい！ｗ
色々と自分の境遇とか困ったことに至る背景とか語りたい気持ちはわかりますが、こういう場では端的に聞きたいことだけを書くほうが回答者としては理解がしやすいですし好感がもてますよ。

[hrksh]

そうですね。次回きをつけます。

Answer 1

一週間は7日なので、日数を7で割れば近い値がでますが、月初めはずれていますので、そこをどう計算するかですね。
とりあえずこんな感じでできると思いますのでお試しください。

' 月初めの曜日を求める
fw = Weekday(Year(Now()) & "/" & Month(Now()) & "/01")
' 本日日付を求めて月初めの曜日分ずらす
d = Day(Now()) + fw - 1
' 日数を7で割って切り上げた数が答え
wscript.echo Round(d / 7 + 0.5, 0) & "週目"

Comments

[hrksh]

ほえ～　なるほど。ありがとうございます。

Answer 2

第何週かの算出法

・今月の１日は何曜日かを調べる
・そこから、今月のはじめての日曜は何日かを算出
・今日の日付からはじめての日曜の日の差分を取り、７で割れば第何週かわかる

というのでどうでしょう

Comments

[hrksh]

ありがとうございます。
こうした算出法はどうしてこうすればできると分かるんですか？
こういうやり方を覚えるものなんでしょうか

Answer 3

DateDiff 関数 (Visual Basic for Applications) | Microsoft Docs

上記の関数を使って、

Dim firstday 
firstday = DateSerial(Year(Date), Month(Date), 1)
MsgBox Datediff("ww",firstday,Date)+1 & "週目"

Comments

[hrksh]

ありがとうございます。
本来ならこうすべきですね。簡潔ですし。
あえて悩む必要も無かったですね〜

Answer 4

２方回答を頂いたので、それを元に作りました。
やったあ・・・・・・

Option Explicit

Public Sub hoge()

    Dim today
    Dim wkFolderName '週ごとのフォルダ名
    today = Date()
    'とりあえず、これができてニッコリした
    '振り分け先のフォルダ名がここで取れれば良い　ex) Week1, Week2, Week3 ...
    wkFolderName = getFuriwakeWeekName(today) 
    wkFolderName = getFuriwakeWeekName2(today) 
    
    msgbox wkFolderName

End Sub

'引数は今日として分ける先のフォルダ名を判定する
Private Function getFuriwakeWeekName(today)
    'return any one of Week1, Week2, Week3, Week4, Week5 (Week6) ...
    Dim firstday '当月初めの日付
    Dim week '曜日    
    Dim difftoSunday '初めての日曜日までの差分
    Dim days '日数
    
    firstday = DateSerial(Year(today), Month(today), 1)
    '今月は金曜日（=5）から始まった
    week = weekday(firstday)
    '日曜日まで何日あるのか調べる
    difftoSunday = 6 - week + 1 
    '今月の日数を調べる　今月末日 - 今月初日 + 1 
    days =  DateSerial(Year(today), Month(today) + 1, -1) - firstday + 1
    '残りの日数を７で割り、第何週かを算出する
    if difftosunday = 0 then
        getFuriwakeWeekName = "Week" & CStr(days \ 7) 
    else
        getFuriwakeWeekName = "Week" & CStr(days \ 7 + 1) 
    end if
    
End Function

Private Function getFuriwakeWeekName2(today)
    'return any one of Week1, Week2, Week3, Week4, Week5 (Week6) ...
    Dim firstday '当月初めの日付
    Dim week '曜日    
    Dim slideDay 'ずらした曜日分の日にち
    
    firstday = DateSerial(Year(today), Month(today), 1)
    '今月は金曜日（=5）から始まった
    week = weekday(firstday)
    '曜日分ずらす
    slideDay = DateSerial(Year(today), Month(today), Day(today) + week -1 )
    ggetFuriwakeWeekName2 = Round(d / 7 + 0.5, 0) & "Week"
    
End Function

call hoge