Save workbook to Desktop and email

[HughT]

I would be grateful if any help could be offered on this - I have searched about but could not find anything.

We have a macro enabled template called 'Referral' that we send out to agents. They complete this and save as a workbook and then email it back. The problem is that the naming convention is random and the email subject line is also random so that it is impossible to catalogue. What I would like to do is :

1. Save the work book to the agent's desktop using the filename in cell N8.
2. Then create and send an email to the office email address using the data in N8 as the subject line with the workbook attached to the email.
3. Code to be embedded in an onscreen button so that all the agent has to do is click it and it works automatically.

Apologies if this is a big ask.

Many thanks

HT

 

[VBE313]

In Visual Basic Editor (Alt + F11), go to Tools, References, and go check Microsoft Outlook 16.0 Object Library. After doing this, insert a Module and paste the following code, make sure you change the sheet name as i used "Sheet1" for example. After pasting this code, go to the Developer Ribbon in the excel application, under the "Controls" group go to "Insert", and insert a Form Control Button. and attach this button to the macro that you pasted. Let me know if you have any questions.

Sub HughT()
On Error GoTo errhandler
Dim subjectVal As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Sheets("Sheet1") 'CHANGE THIS TO THE SHEET NAME
    subjectVal = .Range("N8").Value
    ThisWorkbook.SaveAs Filename:=subjectVal, _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled
    With OutMail
        .To = "HughT@mrExcel.com"
        .CC = ""
        .BCC = ""
        .Subject = subjectVal
        .Attachments.Add ActiveWorkbook.FullName
        .Body = "Hi Hugh,"
        .Display
        '.Send      you can send the email without even looking at it
    End With
End With
Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub
errhandler:
MsgBox "Contact Hugh"
End Sub

 

[HughT]

Very many thanks, but I am afraid it didn't work (well the error message did!).
The file didn't save to the Desktop, and it didn't email. Help please?

 

[VBE313]

Please make sure that these two are checked off.

Sub HughT()
'On Error GoTo errhandler
Dim subjectVal As String
Dim strPath As String
strPath = Environ("USERPROFILE") & "\Desktop\"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Sheets("Sheet1") 'CHANGE THIS TO THE SHEET NAME
    subjectVal = .Range("N8").Value
Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
ActiveWorkbook.SaveAs Path & subjectVal
    With OutMail
        .To = "HughT@mrExcel.com"
        .CC = ""
        .BCC = ""
        .Subject = subjectVal
        .Attachments.Add ActiveWorkbook.FullName
        .Body = "Hi Hugh,"
        .Display
        '.Send      you can send the email without even looking at it
    End With
End With
Set OutMail = Nothing
Set OutApp = Nothing
'Exit Sub
'errhandler:
'MsgBox "Contact Hugh"
End Sub

 

[HughT]

Thank you so much! This is genius!

 

[VBE313]

you are welcome!

 

[HughT]

Got shouted at by the hierarchy! Apparently saving to the Desktop is a big no no because a file could sit there forever and not be found.
Is it possible therefore to format the file 'Save As' title as the contents of cell N8? (this contains the name, office and date, concatenated from data in the form) so that the user is presented with a predefined file name? I seem to recall that a previous version of Excel automatically defaulted the file name to whatever was in A1, but it doesn't seem to do that any more.

 

[VBE313]

Sorry I was a little confused with your response. Can you please show me an example of what the document name would be saved as?

 

[HughT]

It would be the contents of N8 which will be the name, workplace and date. These are concatenated in N8 from three other cells on the form which the user inputs. The date is in dd-mmm-yy format so it doesn't contain any forward slashes (/).
The idea is that all worksheets would be saved in a folder and would automatically order themselves by name, workplace and date so we can identify who sent it, from where, and when. Unless we have a specified format, users simply put in whatever they like, which is usually not much!

Again, many thanks for your help.

 

[VBE313]

I changed the path route, you can update it accordingly so that you can specify the folder.

Sub HughT()
'On Error GoTo errhandler
Dim subjectVal As String
Dim strPath As String
strPath = Environ("USERPROFILE") & "\Desktop\"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Sheets("Sheet1") 'CHANGE THIS TO THE SHEET NAME
    subjectVal = .Range("N8").Value
Path = "C:\Users\HughT\Documents" & "\" 'HERE IS WHERE YOU SPECIFY THE FOLDER
ActiveWorkbook.SaveAs Path & subjectVal
    With OutMail
        .To = "HughT@mrExcel.com"
        .CC = ""
        .BCC = ""
        .Subject = subjectVal
        .Attachments.Add ActiveWorkbook.FullName
        .Body = "Hi Hugh,"
        .Display
        '.Send      you can send the email without even looking at it
    End With
End With
Set OutMail = Nothing
Set OutApp = Nothing
'Exit Sub
'errhandler:
'MsgBox "Contact Hugh"
End Sub