运行时错误' 1004&#39 ;;方法'保存对象' _Workbook"失败

时间:2018-04-04 21:15:20

标签: excel vba excel-vba

我正在尝试使用我的材料订单模板向团队组发送电子邮件,并根据单元格范围将文件保存到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

0 个答案:

没有答案