フォルダ削除

環境/言語:[Win2000、VB6.0]
分類:[その他]

こんにちは。

Dドライブ「テストフォルダ」の下に「DATA_現在の日付」と言うフォルダがあります。
これはVBでSETステートメントを使用して作成されています。

このDドライブにある「DATA_現在の日付」フォルダをLOOPで検索し、現在日付から1ヶ月以上前のフォルダの削除をしようとしています。
下記のプログラムでフォルダ名を調べています。

Dim sDir As String
Dim sKekka As String

sDir = "D:\TEST\"
sKekka = Dir(sDir, vbDirectory)
Do
If sKekka = "" Then
Exit Do
End If
If sKekka = "." Or sKekka = ".." Then
Else
If GetAttr(sDir & sKekka) = vbDirectory Then
Debug.Print sKekka
End If
End If
sKekka = Dir
Loop

このプログラムに"もし「DATA_現在の日付(yyyymmdd)」フォルダの現在の日付部分が現在の日付より1ヶ月以上前だったらこのフォルダを削除する"という文を足したいです。

フォルダの削除は"Setステートメントを使用し、objectvar.DeleteFolder(sKekka)"でできると思うのですが、日付が1ヶ月前だったらがわかりません…(T0T)
DateAdd関数を使用するのかなと言うことはわかりました。
DateAdd("m",-1,date)だと"Date"yyyy/mm/ddなのでFORMAT関数で何かしなくては…。
フォルダ名の日付部分も抽出しなければいけないですよね？
いろいろ使用する関数はなんとなく分かるのですが、どのように組み合わせたら上手くいくのかが全く分からずとても困っています(@_@;)
どなたかお力をお貸し頂けないでしょうか。

あの〜一つ質問です。
掲示板書き込み時にある「分類」ってなんですか？
良く分からないのですが…その他で良かったでしょうか？

VB6でしたら、DateDiff()が使えます。
以下のような関数にしてはいかがでしょうか？

'strFolder はフォルダのパス（d:\text\DATA_20031105 とか）
Function KillOldFolder(ByVal strPath$) As Boolean

　　Dim n&
　　Dim strFolder$
　　Dim dt1 As Date, dt2 As Date
　　
　　'パスからフォルダ名を取り出す
　　n = InStrRev(strPath, "\")
　　If (0 < n) Then
　　　　strFolder = Mid(strPath, n + 1)
　　Else
　　　　strFolder = strPath
　　End If
　　
　　n = Len(strFolder)
　　
　　'DATA_yyyymmdd の長さがあるか
　　If (n < 13) Then
　　　　GoTo NoDelete
　　End If
　　
　　'一応チェック
　　If (Left(strFolder, 5) <> "DATA_") Then
　　　　GoTo NoDelete
　　End If

　　'エラー対応（CDate() の失敗でも起こるので）
　　On Error GoTo NoDelete
　　
　　'今日
　　dt1 = Date
　　
　　'フォルダ日付
　　dt2 = CDate(Mid(strFolder, 6, 4) & "/" & Mid(strFolder, 10, 2) & "/" & Mid(strFolder, 12, 2))

　　'日付間隔
　　n = DateDiff("m", dt1, dt2)
　　
　　'１ヶ月以上昔か
　　If (n <= -1) Then
　　　　
　　　　'strPath 内のファイルを全て消去する（サブディレクトリ内を含む）
　　　　'省略
　　　　'作って下さい
　　　　
　　　　'フォルダの消去
　　　　RmDir strPath
　　Else
　　　　GoTo NoDelete
　　End If
　　
　　
　　KillOldFolder = True
　　Exit Function

NoDelete:
　　　　KillOldFolder = False
　　　　Exit Function

End Function

(tab を全角ブランクにしてあります）

うにさん、レスありがとうございます。

自分の持っていたサンプルプログラムにうにさんのプログラムを参考にした分を合わせて下記のようなプログラムに仕上げてみました。
このプログラムだと実行時にエラーが発生します。
これは自分で考えた部分で「フォルダの削除」のところです。
エラー内容は"コンパイルエラー Functionまたは変数が必要です。"で、カーソルが「DeleteFile」に行きます。
どのようにしたらエラーが出なくなるのかわかりません。
Deleteの場合、変数の定義で何か他の設定が必要ですか？
参照設定が必要ですか？

Dim obj_FSO As Scripting.FileSystemObject
Dim LOG_Text As Scripting.File
Dim sDir As String
Dim sKekka As String
Dim Fol_date As String
Dim month

sDir = "D:\TEST\"
sKekka = Dir(sDir, vbDirectory)

Do
　If sKekka = "" Then
Exit Do
　End If
If GetAttr(sDir & sKekka) = vbDirectory Then
　Fol_date = CDate(Mid(sKekka, 11, 4) & "/" & Mid(sKekka, 15, 2) & "/" & Mid(sKekka, 17, 2))
'日付間隔
month = DateDiff("m", Date, Fol_date)

'１ヶ月以上昔か
If (month <= -1) Then
　
　'フォルダの削除
Set LOG_Text = obj_FSO.DeleteFile(sKekka)

　End If
　Set LOG_Folder = Nothing
End If

sKekka = Dir
Loop

実行時のエラーの原因として、想像される事は、

１．フォルダが空でない。
２．フォルダ名の指定がフルパス（d:\temp\DATA_20031106 等）でない。
　　フルパス指定しないのであれば、カレントフォルダを移動して、直に
　　フォルダにアクセスできる状態にしておく必要がある。

ではないでしょうか？（たぶん２だと思いますが）

　一度、

---------------------------------------

On Error Goto Honyarara

'エラーの起こりそうなステートメント
xxxxxxxxx

Honyarara:
　　Msgbox Error

-----------------------------------------------
とか、入れてみて、エラーの原因を表示してみて下さい。
他の場合でも、MsgBox Error はエラーの原因を知るのには有効ですよ。
お試し下さい。

おはようございます。

うにさんの言う通り「フォルダ名の指定がフルパス（d:\temp\DATA_20031106 等）じゃありませんでした…。
どうもすいません。
これで解決です。
どうもありがとうございました。