如何修正VBA代码以去除导出PDF文件名中的.xlsm后缀？

你当前的VBA代码生成PDF时，会把带.xlsm后缀的Excel文件名直接拼接到PDF文件名里，导致出现example.xlsm.pdf这类多余后缀的情况，同时代码里的路径拼接存在重复斜杠问题，以下是修正方案：

核心修改点 #

• 提取Excel文件名的主名称部分（去掉.xlsm后缀）：用InStrRev函数定位文件名中最后一个.的位置，再用Left截取前面的内容。
• 修正路径中的重复斜杠：原代码里"路径\" & "\"会生成路径\\，直接去掉多余的\"即可。
• 可选替换：如果要改用L3单元格值命名，直接把提取文件名的部分换成Range("L3").Value即可（你提到二者内容一致，两种方式通用）。

修改后的完整代码 #

Sub PDF()
    Dim pdfFileName As String
    
    ' 提取不带Excel后缀的文件名（若用L3值，替换成pdfFileName = Range("L3").Value）
    pdfFileName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
    
    If Range("D51") = "name1" Then
        On Error Resume Next
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            FileName:="C:\Users\example\Documents\" & pdfFileName, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
    ElseIf Range("D51") = "name2" Then
        On Error Resume Next
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            FileName:="C:\Users\tree\Documents\" & pdfFileName, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
    ElseIf Range("D51") = "name3" Then
        On Error Resume Next
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            FileName:="C:\Lone\" & pdfFileName, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
    End If
End Sub

关键代码说明 #

• InStrRev(ActiveWorkbook.Name, ".")：从右往左查找文件名中最后一个.的位置，比如example.xlsm会返回9（字符计数从1开始）。
• Left(ActiveWorkbook.Name, 位置-1)：截取从开头到.之前的所有字符，得到纯文件名example。
• ExportAsFixedFormat会自动为生成的文件添加.pdf后缀，无需手动拼接。

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