'本程序具有删除功能,不可恢复,慎重
'本程序只保留一个最后的子文件夹。
'On Error Resume Next
Dim fso, sPath As String
Dim myFolder, curFolder
Dim strPath As String, dteCreate As Date
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "选择你要搜索的文件夹:", OPTIONS, strPath)
If objFolder Is Nothing Then
MsgBox "您没有选择任何有效目录!"
Exit Sub
Else
Set objFolderItem = objFolder.Self
sPath = objFolderItem.Path
Set fso = CreateObject("scripting.filesystemobject")
Set curFolders = fso.GetFolder(sPath)
dteCreate = "1900-1-1"'如果需要只删除最早文件夹,这里改为dteCreate =now
If curFolders.subfolders.Count >1 Then
For Each myFolder In curFolders.subfolders
Debug.Print sPath &IIf(Len(sPath) = 3, "", "\") &myFolder.Name, myFolder.DateCreated
If dteCreate <myFolder.DateCreated Then'如果需要只删除最早文件夹,这里改为>号
strPath = sPath &IIf(Len(sPath) = 3, "", "\") &myFolder.Name
dteCreate = myFolder.DateCreated
End If
Next
MsgBox strPath &"创建最晚,创建时间" &dteCreate &vbCrLf &"下面删除较早的文件夹"
For Each myFolder In curFolders.subfolders
If dteCreate <>myFolder.DateCreated And strPath <>sPath &IIf(Len(sPath) = 3, "", "\") &myFolder.Name Then'如果需要只删除最早文件夹,这里把<>改为=
'myFolder.Delete True'本行具有删除功能,不可恢复,慎重
End If
Next
End If
Set fso = Nothing
End If
End Sub
Dim ObjFileSystem As New FileSystemObject '需引用MicrosoftScripting RuntimeDim ObjFile As File
Set ObjFile = ObjFileSystem.GetFile("d:/19.txt")'文件名
Debug.Print ObjFile.DateCreated '文件创建时间
Debug.Print ObjFile.DateLastAccessed '文件访问时间
Debug.Print ObjFile.DateLastModified '文件修改时间
FileSizes = ObjFile.Size ‘文件大小 字节为单位
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)