链接到新创建的Excel文件

时间:2018-04-05 20:49:01

标签: excel vba excel-vba outlook outlook-vba

我有一个带有VBA代码的Excel模板,用于执行SaveCopyAs和发送电子邮件。

用户输入信息,SaveCopyAs在代码中指定的文件夹位置创建一个新文件,该文件具有基于单元格值的通用名称。然后他们点击一个按钮,自动将电子邮件填充到整个组。

电子邮件收件人只能打开模板而不能打开新文件。

如何链接到新位置的文件?

Private Sub cmdNot_Click()

    If Application.UserName = "Thai Nguyen" Then

        Dim OutApp As Object
        Dim OutMail As Object
        Dim fileName As String
        Dim mSubject As String
        Dim signature As String
        Dim fname As String
        Dim mBody As String
        Dim rng As Range
        Dim rng1 As Range
        Dim ws As Worksheet
        Dim mailTo As String

        Set ws = Sheets("MRO")
        fname = ws.Range("B4")
        mSubject = "MRO Template" & " - For - " & Range("C6").Value

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        mBody = "\\Obmfg01\bms\000-Draft\Kaizen Training\Material Request\Manufacturing Change Order.xlsm"
        mBody = "<font size=""3"" face=""Calibri"">" & _
            "Dear Team,<br><br>" & _
            "Please open the file from below link and put your signature on the respective cell after you completed your task.<br><B>" & _
            ActiveWorkbook.Name & "</B> is created.<br>" & _
            "Click on this link to open the file : " & _
            "<A HREF=""file://" & ThisWorkbook.FullName & _
            """>Link to Workbook</A>" & _
            "<br><br>Best Regards," & _
            "<br><br></front>"

            With OutMail
                .display
            End With
            signature = OutMail.body
            With Application
                .EnableEvents = False
                .ScreenUpdating = False
            End With

            With OutMail
                '.To = "email"
                .To = "materials@VMAG.com"
                .CC = ""
                .BCC = ""
                .Subject = mSubject
                '.body = "Dear Team," & vbCrLf & vbCrLf & "Please open the file from below link and put your signature on the respective cell and save the sheet"
                '.htmlbody = RangetoHTML(rng)
                .htmlbody = mBody
                '.Attachments.Add fileName
                .display
            End With
            'ws.PageSetup.RightHeader = "&""Calibri,italic""&11& " & ws.Range("A1")
            ws.Protect ("MRO")
            Path = "\\000-Draft\Kaizen Training\Material Request\New\"
            fileName = Range("C6").Value
            ActiveWorkbook.SaveCopyAs fileName:=Path & fileName & ".xlsm"
            ActiveWorkbook.Close False
            ActiveWorkbook.Close
            ActiveWorkbook.Close
            On Error GoTo 0

            Set OutMail = Nothing
            Set OutApp = Nothing

            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With

        Else
            MsgBox "You are not authorised to send MRO form, please check with Template owner", vbInformation
        End If

    End Sub

1 个答案:

答案 0 :(得分:0)

在将其链接到电子邮件之前,您需要Sum(Num[FriendlyName1]) + [FriendlyName2] give back FriendlyName1 Count([FriendlyName1])/[FriendlyName2] give back FriendlyName1 [FriendlyName1] + [FriendlyName2] no matches

实施例

SaveCopyAs
    Dim path As String
    path = "\\000-Draft\Kaizen Training\Material Request\New\"
    fileName = ws.Range("C6").Value
    ActiveWorkbook.SaveCopyAs fileName:=path & fileName & ".xlsm"

    mBody = "<font size=""3"" face=""Calibri"">" & _
        "Dear Team,<br><br>" & _
        "Please open the file from below link and put your signature on the respective cell after you completed your task.<br><B>" & _
        fileName & ".xlsm" & "</B> is created.<br>" & _
        "Click on this link to open the file : " & _
        "<A HREF=""file://" & path & fileName & ".xlsm" & _
        """>Link to Workbook</A>" & _
        "<br><br>Best Regards," & _
        "<br><br></front>"