Access VBA 基于表单值实现文件夹名称自动递增创建的方法问询

原代码核心问题 #

• 变量i未初始化，也没有读取现有文件夹最大序号的逻辑
• 误用fso.FileExists判断文件夹，应该使用fso.FolderExists
• 逻辑判断反向：现有判断是文件夹存在时才创建，不符合需求
• 仅适配了2个序号的场景，无法支持持续递增的需求

实现代码 #

注意：运行前请先在VBA编辑器的「工具-引用」中勾选「Microsoft Scripting Runtime」，否则会报类型定义错误。

Sub CreateIncrementFolder()
    Dim filepath As String
    Dim i As Integer
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    
    ' 先校验上级路径是否存在
    If Not fso.FolderExists(Path2) Then
        MsgBox "上级路径不存在，请检查Path2赋值是否正确"
        Exit Sub
    End If
    
    ' 从1开始找第一个未被使用的序号
    i = 1
    Do While True
        ' 不需要TimeDateTeam前缀的话，删掉Me!TimeDateTeam.Value即可
        filepath = Path2 & "\" & Me!TimeDateTeam.Value & "Test " & i
        If Not fso.FolderExists(filepath) Then
            Exit Do
        End If
        i = i + 1
    Loop
    
    ' 创建找到的序号对应的文件夹
    fso.CreateFolder filepath
    MsgBox "文件夹创建成功：" & filepath
    
    Set fso = Nothing
End Sub

逻辑说明 #

• 自动从序号1开始逐个校验对应文件夹是否存在，找到第一个空序号就创建对应文件夹，天然实现每次新建自动递增的效果
• 兼容自定义前缀需求：不需要TimeDateTeam.Value前缀的话，删除路径拼接语句里的对应字段即可，文件夹名称会直接变为Test 1、Test 2格式
• 增加了上级路径合法性校验，避免路径错误导致的创建失败

内容的提问来源于stack exchange，提问作者ndemo