Excel VBA宏修改需求：指定列导出CSV及自定义保存设置

Sub export_button()
    Dim tbl As ListObject
    Dim csvFilePath As String
    Dim fNum As Integer
    Dim tblArr
    Dim csvVal As String
    Dim colIndex1 As Integer, colIndex2 As Integer
    Dim basePath As String
    Dim ordersFolder As String
    Dim customerFolder As String
    Dim customerName As String
    Dim currentDate As String
    
    ' 定位到目标表格
    Set tbl = Worksheets("Generate Order").ListObjects("generateOrder")
    
    ' 获取C3单元格的值（用于文件夹和文件名）
    customerName = Trim(Worksheets("Generate Order").Range("C3").Value)
    If customerName = "" Then
        MsgBox "单元格C3不能为空，请填写后重试！", vbExclamation
        Exit Sub
    End If
    
    ' 格式化当前日期（避免出现/等系统禁止的文件名字符）
    currentDate = Format(Date, "yyyy-mm-dd")
    
    ' 获取工作簿所在文件夹路径
    basePath = ThisWorkbook.Path
    If basePath = "" Then
        MsgBox "请先保存工作簿，否则无法确定文件保存路径！", vbExclamation
        Exit Sub
    End If
    
    ' 构建文件夹路径
    ordersFolder = basePath & "\Orders\"
    customerFolder = ordersFolder & customerName & "\"
    
    ' 自动创建文件夹（先检查是否存在，避免报错）
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(ordersFolder) Then
        fso.CreateFolder ordersFolder
    End If
    If Not fso.FolderExists(customerFolder) Then
        fso.CreateFolder customerFolder
    End If
    Set fso = Nothing
    
    ' 构造最终CSV文件路径
    csvFilePath = customerFolder & customerName & "-order-" & currentDate & ".csv"
    
    ' 找到指定列的索引（处理表头换行的特殊情况）
    On Error Resume Next
    colIndex1 = tbl.ListColumns("PUBLISHER" & vbCrLf & "ITEM #").Index
    colIndex2 = tbl.ListColumns("REORDER QTY").Index
    On Error GoTo 0
    
    ' 检查指定列是否存在
    If colIndex1 = 0 Or colIndex2 = 0 Then
        MsgBox "表格中未找到指定列：「PUBLISHER ITEM #」或「REORDER QTY」", vbCritical
        Exit Sub
    End If
    
    ' 获取表格数据区域
    tblArr = tbl.DataBodyRange.Value
    
    ' 打开CSV文件准备写入
    fNum = FreeFile()
    Open csvFilePath For Output As #fNum
    
    ' 写入CSV表头
    csvVal = tbl.ListColumns(colIndex1).Name & "," & tbl.ListColumns(colIndex2).Name
    Print #fNum, csvVal
    
    ' 逐行写入指定列的数据
    For i = 1 To UBound(tblArr)
        csvVal = tblArr(i, colIndex1) & "," & tblArr(i, colIndex2)
        Print #fNum, csvVal
    Next i
    
    ' 关闭文件
    Close #fNum
    
    ' 释放对象并提示完成
    Set tbl = Nothing
    MsgBox "文件已成功导出至：" & vbCrLf & csvFilePath, vbInformation
End Sub

关键改动详解 #

1. 仅导出指定列 #

• 针对表头中「PUBLISHER ITEM #」的换行问题，用"PUBLISHER" & vbCrLf & "ITEM #"精准匹配列名，获取对应的列索引
• 单独提取每行的「PUBLISHER ITEM #」和「REORDER QTY」两列数据，避免导出多余列

2. 自定义文件名 #

• 从Generate Order工作表的C3单元格提取名称，结合格式化后的当前日期（yyyy-mm-dd格式避免特殊字符），生成符合要求的文件名
• 文件名格式严格遵循[C3的值]-order-[当前日期].csv

3. 自动创建文件夹结构 #

• 获取当前工作簿的保存路径，自动在其下创建Orders子文件夹，再在Orders内创建以C3值命名的子文件夹
• 使用FileSystemObject检查文件夹是否存在，避免因重复创建导致的报错

额外优化 #

• 添加了空值校验：C3为空或指定列不存在时，弹出提示引导用户修正
• 写入CSV表头，让导出的文件结构更清晰
• 导出完成后弹出提示框，告知用户文件的具体保存路径
• 处理了工作簿未保存的情况（此时无法获取路径，提示用户先保存工作簿）

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