Access中按联系人ID判断创建目录问题：修改信息重复生成目录

原代码的核心问题是逻辑偏差：你需要通过目录名称最后4位（联系人ID）判断是否存在对应目录，但当前代码只检查了拼接的完整目录路径是否存在且后缀匹配——一旦修改姓名部分，拼接的路径就会变化，Dir返回空值，自然会触发新目录的创建。另外代码里还有个笔误：vdNullString应为vbNullString，虽未报错但属于写法错误。

修正后的VBA代码 #

Private Sub MakeContactFolder()
    Dim basePath As String
    Dim targetIdSuffix As String
    Dim existingFolder As String
    Dim folderExists As Boolean
    
    ' 构建上级目录路径
    basePath = Application.CurrentProject.Path & "\" & Me.TxtCustOrSupp.Value
    
    ' 若上级目录不存在则创建
    If Dir(basePath, vbDirectory) = vbNullString Then
        MkDir basePath
    End If
    
    ' 提取当前联系人的ID后缀（最后4位）
    targetIdSuffix = Right(Me.TxtContactAs.Value, 4)
    folderExists = False
    
    ' 遍历上级目录下的所有子目录，检查是否有匹配ID后缀的目录
    existingFolder = Dir(basePath & "\*", vbDirectory)
    Do While existingFolder <> ""
        ' 跳过系统默认的.和..目录
        If existingFolder <> "." And existingFolder <> ".." Then
            ' 匹配目录名称最后4位
            If Right(existingFolder, 4) = targetIdSuffix Then
                folderExists = True
                Exit Do ' 找到匹配项，终止循环
            End If
        End If
        existingFolder = Dir() ' 读取下一个目录
    Loop
    
    ' 未找到匹配目录时，创建新目录
    If Not folderExists Then
        MkDir basePath & "\" & Me.TxtContactAs.Value
    End If
End Sub

代码说明 #

• 先确保上级目录存在，修正了路径分隔符（Access中单个\即可，无需\\）
• 提取当前联系人的ID后缀作为匹配依据
• 遍历上级目录下的所有子目录，逐个校验目录名称的最后4位是否与目标ID后缀一致
• 仅当完全找不到匹配目录时才创建新目录，这样即使修改姓名部分，只要ID后缀对应的目录已存在，就不会重复创建

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