我正在尝试使用我的材料订单模板向团队组发送电子邮件,并根据单元格范围将文件保存到Excel文件中具有特定名称的特定位置。
然而,除了代码ActiveWorkbook.SaveAs fileName:=Path & fileName & ".xlsm", FileFormat:=xlNormal.
之外,其他一切都运行正常。我在上面的代码中得到了黄色。它不允许我将文件保存到具有新名称的文件夹。
这里是代码
Private Sub cmdNot_Click()
If Application.UserName = "Ryan Tory" 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 = "\\000-Draft\Material Request\Manufacturing Change Order.xlsm" & " For " & Range("C6").Value
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://" & ActiveWorkbook.FullName & _
""">Link to the file</A>" & _
"<br><br>Best Regards," & _
"<br><br></font>"
With OutMail
.display
End With
signature = OutMail.body
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With OutMail
'.To = "email"
.To = "materials@OFTMG.com"
.CC = ""
.BCC = ""
.Subject = mSubject & " For "
'.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")
ws.Protect ("MRO")
Path = "\\000-Draft\Kaizen Training\Material Request\New\"
fileName = Range("C6")
ActiveWorkbook.SaveAs fileName:=Path & fileName & ".xlsm", FileFormat:=xlNormal
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 MRO Owner", vbInformation
End If
End Sub