用VBA新建一个文件夹在当前文件夹中，并以当前日期命名

在Excel VBA中，你可以使用`CreateObject`函数结合`Shell`函数来创建一个新的文件夹。以下是一个示例代码，它会在当前工作目录下创建一个新文件夹，名字包含当前日期：

Sub CreateFolderWithTodayDate()
    Dim folderName As String
    Dim folderPath As String
    
    ' 获取当前日期并格式化
    folderName = Format(Now(), "yyyy-mm-dd") ' 例如 2023-03-08

    ' 创建文件夹路径
    folderPath = ThisWorkbook.Path & "\" & folderName
    
    ' 使用Shell函数创建文件夹
    Set objShell = CreateObject("WScript.Shell")
    objShell.NameSpace(folderPath).SelfCreate
    
    ' 显示消息确认文件夹已创建
    MsgBox "文件夹 " & folderName & " 已经成功创建在当前目录下", vbInformation
End Sub

这个宏会执行后，在你的Excel工作簿所在目录下创建一个以今天日期命名的新文件夹。

相关问题

vba怎么新建文件夹并以日期命名

在VBA (Visual Basic for Applications) 中，你可以使用 `FileSystemObject` 对象来创建新的文件夹，并通过当前日期进行命名。以下是一个简单的示例代码，展示如何在指定路径下创建一个新的文件夹，其名称包含今天的日期：

Sub CreateFolderWithDate()
    Dim fso As Object ' FileSystemObject
    Dim folderPath As String
    Dim currentDate As Date
    Dim newFolderPath As String
    
    Set fso = CreateObject("Scripting.FileSystemObject") ' 创建 FileSystemObject

    ' 指定文件夹将要创建的路径
    folderPath = "C:\Your_Directory" ' 将 "Your_Directory" 替换为你实际需要的目录路径

    ' 获取当前日期并格式化
    currentDate = Date
    newFolderPath = folderPath & "\" & Format(currentDate, "yyyy-mm-dd") ' yyyy-mm-dd 格式例如 2023-03-15

    ' 创建新文件夹
    If Not fso.FolderExists(newFolderPath) Then
        fso.CreateFolder newFolderPath ' 如果文件夹不存在则创建
        MsgBox "Folder created successfully: " & newFolderPath, vbInformation
    Else
        MsgBox "Folder already exists at this path.", vbInformation
    End If

    Set fso = Nothing ' 清理内存
End Sub

用VBA写一个代码，在指定位置新建一个Excel表，然后依次打开指定文件夹中每一个Excel表，依次读取表格中25家银行对应日期的收盘价，在新建的Excel表中对应生成25个sheet，每个sheet以银行命名，将每一家银行日期和当天的收盘价整理到对应的sheet中，最后保存。

以下是用VBA实现您要求的代码：

Sub ReadExcelFiles()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim path As String
    Dim filename As String
    Dim bankname As String
    Dim datecol As Long
    Dim closecol As Long
    Dim lastrow As Long
    Dim i As Long
    
    '设置要读取的文件夹路径
    path = "C:\Path\To\Excel\Files\"
    
    '新建一个Excel表
    Set wb = Workbooks.Add
    wb.SaveAs Filename:="C:\Path\To\New\Excel\File.xlsx"
    
    '循环读取文件夹中的Excel表格
    filename = Dir(path & "*.xlsx")
    Do While filename <> ""
        '打开Excel表格
        Workbooks.Open (path & filename)
        Set ws = ActiveSheet
        
        '获取银行名称
        bankname = Replace(filename, ".xlsx", "")
        
        '在新建的Excel表格中新建一个sheet，并以银行名称命名
        wb.Sheets.Add after:=wb.Sheets(wb.Sheets.Count)
        ActiveSheet.Name = bankname
        
        '查找日期和收盘价所在列
        datecol = 0
        closecol = 0
        For i = 1 To 50 '假设日期和收盘价在前50列中
            If ws.Cells(1, i).Value = "日期" Then
                datecol = i
            End If
            If ws.Cells(1, i).Value = "收盘价" Then
                closecol = i
            End If
        Next i
        
        '将日期和收盘价整理到新建的sheet中
        lastrow = ws.Cells(ws.Rows.Count, datecol).End(xlUp).Row
        For i = 2 To lastrow '假设第一行为表头
            wb.Sheets(bankname).Cells(i - 1, 1).Value = ws.Cells(i, datecol).Value
            wb.Sheets(bankname).Cells(i - 1, 2).Value = ws.Cells(i, closecol).Value
        Next i
        
        '关闭Excel表格
        Workbooks(filename).Close
        
        '继续循环读取下一个Excel表格
        filename = Dir
    Loop
    
    '保存新建的Excel表格
    wb.Save
    wb.Close
    
End Sub

请将代码中的路径改为实际的路径，并根据实际情况修改其他参数。注意，该代码假设每个Excel表格的第一行为表头。