VBA Help - Attaching spreadsheet to e-mail + Autosave with name change

[rosswild]

Hello,

I have the following code which I am using so people can e-mail the workbook they are using to a specified address.

That bit works perfectly.

I then added a save function as I wanted the document to be renamed before saving based on a cell in the document. It is being saved in the current location as I didn't want to specify a location as different users/computers will be using the document.

Again this appears to be working as the document is renamed (I can see it's new name at the top of the excel doc), although it doesn't appear in my folder as a new saved document.

The macro then runs through with no errors but then doesn't attach the document.

I can't see what I am doing wrong. Any suggestions would be greatly appreciated.

Sub Mail_workbook_Outlook_1()
   
   
    answer = MsgBox("You are about to e-mail the requisition to the buying department, do you wish to proceed?", vbYesNo)
If answer = vbNo Then Exit Sub
If Range("A24").Value = "Checks - Please resolve the problems below" Then
  MsgBox "Error - You have not completed all the required feilds. Please resolve before sending."
  Exit Sub
End If
 
 Dim wbname As String
 Dim pathONLY, filePATH, fileONLY As String
 filePATH = ThisWorkbook.FullName
 fileONLY = ThisWorkbook.Name
 pathONLY = Left(filePATH, Len(filePATH) - Len(fileONLY))
 wbname = Sheets("Hidden").Range("B10").Value
 On Error Resume Next
 ActiveWorkbook.SaveAs Filename:=pathONLY & wbname & ".xlsm"
 
 
 Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next
    With OutMail
        .To = ThisWorkbook.Sheets("Hidden").Range("B2").Value
        .CC = ThisWorkbook.Sheets("Hidden").Range("B9")
        .BCC = ""
        .Subject = ThisWorkbook.Sheets("Hidden").Range("B7").Value
        .Body = ThisWorkbook.Sheets("Hidden").Range("B8").Value
        .Attachments.Add ActiveWorkbook.FullName
       
        .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Thank you