Question

我在模板中有一个Excel文档。用户输入信息并另存为新的通用编号。然后，他们点击一个按钮，使用Vlookup并根据成本边际自动将电子邮件填充给5个人中的一个。

该文件是另存为但电子邮件收件人无法打开该文件，它读取无效位置。我可以关闭并重新打开新重命名的工作表并将其拖到电子邮件中。我需要链接到电子邮件中显示的新保存文件的名称。

Sub Email_created_Workbook()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim Mess As Object, Recip
    Recip = [Sheet1!B28].Value & "; " & [Sheet1!B27].Value
    Dim strbody As String

    If ActiveWorkbook.Path <> "" Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Hello,<br><br>" & _
                  "There is a New PO awaiting your approval :<br><B>" & _
                  ActiveWorkbook.Name & "</B> is created.<br>" & _
                   "Click on this link to open the file : " & _
                  "<A HREF=""file://" & ActiveWorkbook.FullName & _
                  """>Link to Workbook</A>" & _
                  "<br><br>Regards," & _
                  "<br><br>Automated Approval System</font>"

        On Error Resume Next
        With OutMail
            .To = Recip
            .CC = ""
            .BCC = ""
            .Subject = ActiveWorkbook.Name
            .HTMLBody = strbody
            .Display   'or use .Send
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    Else
        MsgBox "The ActiveWorkbook does not have a path, Save the file first."
    End If
End Sub

文件名确实在我的电子邮件中从PO模板进行调整，但不会打开。

Answer 1

我相信这可以帮助您解决当前问题（在发送之前关闭并重新打开文件）。我已删除了将Outlook对象设置为Nothing的代码的两行。要重新打开当前文件，您可以使用OnTime函数，如下所示：

Sub Email_created_Workbook()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim Mess As Object, Recip
    Recip = [Sheet1!B28].Value & "; " & [Sheet1!B27].Value
    Dim strbody As String

    If ActiveWorkbook.Path <> "" Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        strbody = "<font size=""3"" face=""Calibri"">" & _
              "Hello,<br><br>" & _
              "There is a New PO awaiting your approval :<br><B>" & _
              ActiveWorkbook.Name & "</B> is created.<br>" & _
               "Click on this link to open the file : " & _
              "<A HREF=""file://" & ActiveWorkbook.FullName & _
              """>Link to Workbook</A>" & _
              "<br><br>Regards," & _
              "<br><br>Automated Approval System</font>"

        On Error Resume Next
        With OutMail
            .To = Recip
            .CC = ""
            .BCC = ""
            .Subject = ActiveWorkbook.Name
            .HTMLBody = strbody
            .Display   'or use .Send
         End With
         Application.OnTime Now + TimeValue("00:00:10"), "SendEmail" 
        ThisWorkbook.Close True 'True= yes, save changes 
    Else
        MsgBox "The ActiveWorkbook does not have a path, Save the file first."
     End If
End Sub

Sub SendEmail() 
    Dim OutApp As Object: Set OutApp = GetObject(, "Outlook.Application") 'Grab current instance of Outlook since we already opened the instance prior to restarting Excel
    Dim oInspector As OutApp.Inspector: Set oInspector = OutApp.ActiveInspector
    Dim NewMail As OutApp.MailItem: Set NewMail = oInspector.CurrentItem 'Grab currently open New/Compose Mail window
    NewMail.Send 'Send Email
End Sub

如果这有助于解决您的问题，请与我们联系。

“另存为”文档链接将无法打开，并显示错误消息“..无法找到..正确的位置或网址”

1 个答案: