Excel VBA如何按单元格值创建文件夹分类存储生成的TXT文件

修正后可实现需求的完整VBA代码 #

Sub create_Txt()
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object
    Dim basePath As String, lastName As String, folderPath As String, txtName As String
    
    ' 通用桌面路径，无需手动修改用户名
    basePath = Environ("USERPROFILE") & "\Desktop\"
    Dim i&, lastRow&
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 若表格第1行是表头，将下方i=1改为i=2，避免创建名为「姓氏」的文件夹
    For i = 1 To lastRow
        lastName = Cells(i, 1).Value ' 取当前行姓氏
        folderPath = basePath & lastName & "\" ' 拼接对应姓氏文件夹路径
        
        ' 文件夹不存在则自动创建
        If Not fso.FolderExists(folderPath) Then
            fso.CreateFolder folderPath
        End If
        
        ' 拼接txt文件名：名字+空格+姓氏
        txtName = Cells(i, 2).Value & " " & lastName & ".txt"
        Set oFile = fso.CreateTextFile(folderPath & txtName, True) ' 第二个参数True表示覆盖重名文件，不需要可删除
        oFile.WriteLine Cells(i, 3).Value ' 写入生日信息
        oFile.Close
    Next i
    Set fso = Nothing
    Set oFile = Nothing
End Sub

主要修改说明 #

• 新增文件夹存在性判断逻辑：遍历每行时先校验对应姓氏的文件夹是否存在，不存在就自动创建，避免重复创建报错
• 修正原代码单元格索引错误：原代码错误引用第3列（生日列）作为姓氏，按照你给出的表格结构，第1列为姓氏、第2列为名字、第3列为生日，已对应调整索引
• 替换硬编码桌面路径：用系统变量自动获取当前用户桌面路径，无需手动修改用户名即可适配不同设备
• 新增重名文件覆盖参数：如果不需要覆盖已存在的同名txt，删掉CreateTextFile方法的第二个参数True即可

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