我有一个带有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
答案 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>"