求教:如何建立以日期为名称的目录

Question

请教各位大侠:我想以日期(如20040115)为名称建立目录,并在目录下存放相应的文件,请问如何建立并加以管理?主要是方便用时间查询.如果有什么更好的方法,请大家不要吝啬口水,谢谢.

Answer 1

Private Sub Command1_Click()
Dim s As String
s = Format(Now(), "yyyymmdd")
MkDir App.Path + "\" + s
End Sub

Answer 2

MkDir App.Path & "\" & Format(Date, "yyyymmdd")

Answer 3

Option Explicit
    Dim filesearch As String
    Dim findflag As Boolean
    
    '  清空搜索结果
    Private Sub clrcmd_Click()
        lstfiles.Clear
    End Sub
    
    '  开始查找文件
    Private Sub cmdgo_Click()
    Dim starttime As Single
    Dim i As Integer
    Dim Add As Boolean
    
    lstfiles.Clear '查找文件之前先清空结果
    lstdirs.Clear
    findflag = True '设置查找标志
    stopcmd.Enabled = True  '设置停止查找按钮为可用
    clrcmd.Enabled = False  '设置清空结果按钮为不可用
    starttime = Timer   '记录开始查找时刻
    filesearch = Combo1.Text
    '  将查找文件加入到组合框中
    For i = 0 To Combo1.ListCount - 1
        If Combo1.List(i) <> Combo1.Text Then
            Add = True
        Else
            Add = False
        End If
    Next
    If Add = True Then
        Combo1.AddItem (Combo1.Text)
    End If
    lstdirs.AddItem (Drive1.Drive & "\")
    '   执行查找文件
    Do
        status.Caption = "Searching . . . " & lstdirs.List(0)
        '  调用函数
        findfilesdir lstdirs.List(0)
        '  从目录列表中移除
        lstdirs.RemoveItem 0
        '  中途退出查找
        If findflag = False Then
          Exit Do
        End If
    Loop Until lstdirs.ListCount = 0
    stopcmd.Enabled = False
    clrcmd.Enabled = True
    
    '  显示查找文件的信息
    status.Caption = "用时" & Timer - starttime & "秒 " & "找到" & lstfiles.ListCount & "个文件"
    End Sub
    
    '  用来查找文件的函数
    Public Sub findfilesdir(DirPath As String)
    Dim filestring As String
    DirPath = Trim(DirPath)
    
    If Right(DirPath, 1) <> "\" Then
      DirPath = DirPath & "\"
    End If
    '  使用Dir函数获得DirPath目录下的文件或目录
    filestring = Dir(DirPath & "*.*", vbArchive Or vbHidden Or vbSystem Or vbDirectory)
    Do
      DoEvents '转让控制权，以便让操作系统处理其它的事件
      If filestring = "" Then
        Exit Do
      Else
        If (GetAttr(DirPath & filestring) And vbDirectory) Then
          If Left(filestring, 1) <> "." And Left(filestring, 2) <> ".." Then
            lstdirs.AddItem DirPath & filestring & "\"
          End If
        Else
          '  比较以确定是否是要查找的文件
          If (filestring Like filesearch) Then
          lstfiles.AddItem DirPath & filestring
          End If
        End If
      End If
      filestring = Dir '  返回其他文件名
    Loop
    End Sub
    
    '   结束退出
    Private Sub quitcmd_Click()
        Unload Me
        End
    End Sub
    
    '   停止查找
    Private Sub stopcmd_Click()
        findflag = False
        stopcmd.Enabled = False
    End Sub
    
    Private Sub Form_Load()
        Combo1.AddItem ("*.*")
    End Sub