基于单元格值动态指定文件名与文件夹导出Excel工作表为PDF求助

现有代码核心错误点 #

• 变量声明不规范：VBA多变量同行声明时，仅最后一个标注类型的变量会被定义为字符串，你代码里前三个变量默认是变体类型，匹配单元格值时容易出现类型不兼容
• ExportAsFixedFormat 语法错误：行尾多余逗号，且未补全基础必填参数，也未指定目标工作表为「Prin ini」，仅用ActiveSheet会导致激活其他工作表时导出错误
• 未处理目录名非法字符：M4的日期值如果带/、:等系统禁止的路径字符，会导致创建目录失败
• 导出文件名未加.pdf后缀，部分系统环境下不会自动补全后缀导致导出失败
• 创建目录前未做存在判断，仅靠On Error Resume Next容错逻辑太粗糙，容易出现路径拼接错误

修正后完整可用代码 #

Private Sub CommandButton1_Click()
    ' 统一声明所有变量为字符串类型
    Dim strFilename As String, strDirname As String, strPathname As String, strDefpath As String
    Dim targetSheet As Worksheet
    
    ' 指定目标工作表为Prin ini，避免激活其他表时出错
    Set targetSheet = ThisWorkbook.Worksheets("Prin ini")
    
    ' 基础路径和单元格取值
    strDefpath = "C:\Users\febriantot\Desktop\Data Historis Dummy\"
    ' 格式化M4的日期为合法目录名，比如2024-05-20格式，避免非法字符
    strDirname = Format(targetSheet.Range("M4").Value, "yyyy-mm-dd")
    strFilename = targetSheet.Range("C4").Value & ".pdf" ' 主动加PDF后缀
    
    ' 非空判断
    If strDirname = "" Or strFilename = ".pdf" Then Exit Sub
    
    ' 判断目录是否存在，不存在再创建
    If Dir(strDefpath & strDirname, vbDirectory) = "" Then
        MkDir strDefpath & strDirname
    End If
    
    ' 拼接完整导出路径
    strPathname = strDefpath & strDirname & "\" & strFilename
    
    ' 导出PDF，补全必填参数
    targetSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=strPathname, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False ' 导出后是否自动打开，需要的话改成True
End Sub

注意事项 #

• 如果需要导出后自动打开PDF，把最后一行OpenAfterPublish:=False改成True即可
• 如果M4的日期格式已经是合法的yyyy-mm-dd格式，也可以保留原取值逻辑，格式化处理仅为提升兼容性
• 运行前请确认C:\Users\febriantot\Desktop\Data Historis Dummy\路径真实存在，如果路径变更请同步修改strDefpath的取值

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