无法将Excel / VBA中的PDF保存在一台计算机上

我最近在这里得到了一个Excel电子表格的帮助,这个Excel电子表格允许用户为客户创build报价单。 电子表格使用VBA来允许用户按下一个button,从某些表单生成一个PDF,并将它们附加到一个新的Outlook电子邮件。

不幸的是,这不能在用户的电脑上工作。 这个问题似乎是与生成的PDF。 最初按下button时,什么都没有发生。 我怀疑这是与微软的插件保存为PDF格式,所以我确定它是安装,这是。 在'注释'从代码来的错误信息从Visual Basic中得到真正的错误信息之后,我发现它是这样的:

run-time error '-2147467261 (80004003)': Document not saved. 

点击“debugging”时,突出显示:

 FileName = Create_PDF_Sheet_Level_Names(NamedRange:="addtopdf1", _ FixedFilePathName:=ThisWorkbook.Path & "\" & "Quotation - " & Range("G18") & ".pdf", _ OverwriteIfFileExist:=True, _ OpenPDFAfterPublish:=False) 

其中涉及到:

 Function Create_PDF_Sheet_Level_Names(NamedRange As String, FixedFilePathName As String, _ OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String 'This function will create a PDF with every sheet with 'a sheet level name variable <NamedRange> in it Dim FileFormatstr As String Dim Fname As Variant Dim Ash As Worksheet Dim sh As Worksheet Dim ShArr() As String Dim s As Long Dim SheetLevelName As Name 'Test If the Microsoft Add-in is installed If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _ & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then 'We fill the Array with sheets with the sheet level name variable For Each sh In ActiveWorkbook.Worksheets If sh.Visible = -1 Then Set SheetLevelName = Nothing On Error Resume Next Set SheetLevelName = sh.Names(NamedRange) On Error GoTo 0 If Not SheetLevelName Is Nothing Then s = s + 1 ReDim Preserve ShArr(1 To s) ShArr(s) = sh.Name End If End If Next sh 'We exit the function If there are no sheets with 'a sheet level name variable named <NamedRange> If s = 0 Then Exit Function If FixedFilePathName = "" Then 'Open the GetSaveAsFilename dialog to enter a file name for the pdf FileFormatstr = "PDF Files (*.pdf), *.pdf" Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _ Title:="Create PDF") 'If you cancel this dialog Exit the function If Fname = False Then Exit Function Else Fname = FixedFilePathName End If 'If OverwriteIfFileExist = False we test if the PDF 'already exist in the folder and Exit the function if that is True If OverwriteIfFileExist = False Then If Dir(Fname) <> "" Then Exit Function End If Application.ScreenUpdating = False Application.EnableEvents = False 'Remember the ActiveSheet Set Ash = ActiveSheet 'Select the sheets with the sheet level name in it Sheets(ShArr).Select 'Now the file name is correct we Publish to PDF On Error Resume Next ActiveSheet.ExportAsFixedFormat _ Type:=xlTypePDF, _ FileName:=Fname, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=OpenPDFAfterPublish On Error GoTo 0 'If Publish is Ok the function will return the file name If Dir(Fname) <> "" Then Create_PDF_Sheet_Level_Names = Fname End If Ash.Select Application.ScreenUpdating = True Application.EnableEvents = True End If End Function 

我真的在这里挠头了! 在Excel和Outlook中检查所有设置,并使用我的机器进行检查,包括信任中心设置。 还选中加载项。

  1. 请检查用户是否有足够的磁盘空间来保存PDF文件!
  2. 我build议在调用“ActiveSheet.ExportAsFixedFormat(…)”之前检查PDF全名(path,文件名和文件扩展名;在你的例子中是variables“Fname”)的长度,因为文件名全名)在Microsoft Windows下定期不能超过255个字符(请参阅: 命名文件,path和命名空间 )。