当前用于创建、存档和通过电子邮件发送活动Excel工作表PDF副本的VBA模块不再工作。网络已移动到SharePoint

当前用于创建、存档和通过电子邮件发送活动Excel工作表PDF副本的VBA模块不再工作。网络已移动到SharePoint,excel,vba,sharepoint,pdf-generation,Excel,Vba,Sharepoint,Pdf Generation,敬礼 我工作的公司已将其网络迁移到SharePoint。我用来保存工作表和PDF副本,然后通过电子邮件发送PDF副本的代码不再有效。可能是基于权限的问题,也可能是URL/目标文件夹问题。因此,我不确定如何纠正这个问题。调试错误开始于“如果PDF已经存在,和”创建PDF Option Explicit Sub Routine_email_pdf() Dim EmailSubject As String, EmailSignature As String Dim CurrentMonth

敬礼

我工作的公司已将其网络迁移到SharePoint。我用来保存工作表和PDF副本,然后通过电子邮件发送PDF副本的代码不再有效。可能是基于权限的问题,也可能是URL/目标文件夹问题。因此,我不确定如何纠正这个问题。调试错误开始于“如果PDF已经存在,和”创建PDF

    Option Explicit

Sub Routine_email_pdf()

Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
Dim StrBody As String
CurrentMonth = ""

If MsgBox("This will send a copy to the manager. Continue?", vbYesNo) = vbNo Then Exit Sub

' *****************************************************
' *****     You Can Change These Variables    *********

    EmailSubject = "Routine Status Update (PDF)"   'Change this to change the subject of the email. The current month is added to end of subj line
    OpenPDFAfterCreating = False    'Change this if you want to open the PDF after creating it : TRUE or FALSE
    AlwaysOverwritePDF = False      'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
    DisplayEmail = False 'Change this if you don't want to display the email before sending.  Note, you must have a TO email address specified for this to work
    Email_To = "aperson@domain.com"   'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
    Email_CC = "somename@domain.com"
    Email_BCC = ""
    StrBody = "Attached is the Routine Status Update for" & " " & Format(Now, "mmmm, dd, yyyy - HH:mm") & "."
           
' ******************************************************
    
    DestFolder = "URL address is here now previously a network file path"
            
    'Current date/time
    CurrentMonth = Format(Now, "mmmm, dd, yyyy - HH:mm")
    
    'Create new PDF file name including path and file extension
    PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
                & "_" & Format(Now, "dd-mmm-yyyy_hh-mm-ss") & ".pdf"

    'If the PDF already exist
    

        Else
        
            On Error Resume Next
            Kill PDFFile
            
        End If
        
        If Err.Number <> 0 Then
        
            MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
                
            Exit Sub
        
        End If
            
    End If
   

    'Create the PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=OpenPDFAfterCreating

    'Create an Outlook object and new mail message
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
        
    'Display email and specify To, Subject, etc
    With OutlookMail
        

        .Display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        .Attachments.Add PDFFile
        .HTMLBody = StrBody
                
        If DisplayEmail = False Then
            
            .Send
            
        End If
        
    End With
    
 
End Sub
选项显式
子程序\u电子邮件\u pdf()
Dim EmailSubject作为字符串,EmailSignature作为字符串
Dim CurrentMonth作为字符串,DestFolder作为字符串,Pdfile作为字符串
Dim Email_To As String,Email_CC As String,Email_BCC As String
Dim OpenPDFaftCreating为布尔值,AlwaysOverwritePDF为布尔值,DisplayEmail为布尔值
Dim将EPDF覆盖为VbMsgBoxResult
Dim OutlookApp作为对象,OutlookMail作为对象
像弦一样暗的链子
CurrentMonth=“”
如果MsgBox(“这将向管理器发送一份副本。是否继续?”,vbYesNo)=vbNo,则退出Sub
' *****************************************************
'******您可以更改这些变量*********
EmailSubject=“例行状态更新(PDF)”,更改此选项可更改电子邮件的主题。当前月份添加到Subc行的末尾
OpenPDFAfterCreating=False“如果要在创建PDF后打开它,请更改此选项:TRUE或False
AlwaysOverwritePDF=False“如果您始终希望覆盖已存在的PDF,请更改此选项:TRUE或False
DisplayEmail=False“如果您不想在发送前显示电子邮件,请更改此选项。注意,您必须指定一个收件人电子邮件地址才能使用此功能
电邮至“aperson@domain.com“'如果要指定电子邮件,例如ActiveSheet.Range(“H1”)以从单元格H1获取电子邮件,请更改此选项
电子邮件_CC=”somename@domain.com"
电子邮件_BCC=“”
StrBody=“附件是“&”格式的例行状态更新(现在是“mmmm,dd,yyyy-HH:mm”)&”
' ******************************************************
DestFolder=“URL地址现在是网络文件路径”
'当前日期/时间
CurrentMonth=格式(现在为“毫米、日、年-小时:毫米”)
'创建新的PDF文件名,包括路径和文件扩展名
PDFFile=DestFolder&Application.PathSeparator&ActiveSheet.Name_
&格式(现在是dd-mmm-yyyy\U hh-mm-ss)和.pdf
'如果PDF已经存在
其他的
出错时继续下一步
杀死Pdfile
如果结束
如果错误号为0,则
MsgBox“无法删除现有文件。请确保该文件未打开或未受写保护。”_
&vbCrLf&vbCrLf&“按“确定”退出此宏。”,vbCritical,“无法删除文件”
出口接头
如果结束
如果结束
'创建PDF
ActiveSheet.ExportAsFixedFormat类型:=xlTypePDF,文件名:=Pdfile,质量:=xlQualityStandard,IncludeDocProperties:=True,忽略打印区域_
:=False,OpenAfterPublish:=OpenPDFAfterCreating
'创建Outlook对象和新邮件消息
设置OutlookApp=CreateObject(“Outlook.Application”)
设置OutlookMail=OutlookApp.CreateItem(0)
'显示电子邮件并指定收件人、主题等
与了望邮件
.展示
.To=通过电子邮件发送至
.CC=电子邮件\u CC
.BCC=电子邮件\u BCC
.Subject=EmailSubject&CurrentMonth
.Attachments.Add PDFFile
.HTMLBody=StrBody
如果DisplayEmail=False,则
.发送
如果结束
以
端接头

so DestFolder=是保存pdf的文件路径。我移除了大部分If-else潜艇。我现在唯一的问题是附件.add PDFFile。电子邮件会打开,但不会附加pdf,也不会在文件路径中创建pdf