Save File Name based on Text in Named Range on Users Desktop & Email that file. Has to work for Windows & Mac

Armygeddan

Board Regular
Joined
Apr 6, 2016
Messages
79
Hello,


I'm looking for a code or a good starting point where a users clicks a button and the following happens:


1. The Excel File first gets Saved with a naming convention of the Text that has the Named Range of AcquisitonTitle.
2. The the file is to be saved on the users Desktop (this possible or would just creating a temp file be better?)
3. An Email is generated but not sent with that file attached
4. This has to work on goth Windows & Mac (I know Macs use backslash instead of forward slash so somehow it needs to figure out what operating system the user is using)


Even a good starting point is helpful. I'm not an Excel expert but any help is appreciated. Current code I have works 100% on Windows but not Macs so I'm thinking maybe delete the save entirely to avoid the slashes issue?

Current Code I have:

Code:
Sub SaveAndEmailAcquisition()


Dim OutApp                As Object
Dim OutMail               As Object


Dim StrBody               As String
Dim StrTo                 As String
Dim StrSubject            As String
Dim StrAtt                As String
Dim StrSignature          As String
Dim strGenericFilePath    As String: strGenericFilePath = "\\FILE LOCATION FOR WINDOWS"
Dim strYearSlash          As String: strYearSlash = Year(Date) & "\"
Dim strMonthSlash         As String: strMonthSlash = CStr(Format(DateAdd("M", 0, Date), "MM")) & "\"
Dim strYearBracket        As String: strYearBracket = Year(Date) & "_"
Dim strMonthBracket       As String: strMonthBracket = CStr(Format(DateAdd("M", 0, Date), "MM")) & "_"
Dim strFileName           As String: strFileName = Sheets("Acquisition").Range("AcquisitionTitle") & " Acquisition Request Form"


 ' Creates Message Box asking if Form has been complete. If not, it cancels code to continue
MSG1 = MsgBox("Have you filled out EVERY box of information on this form?", vbYesNo)


If MSG1 = vbNo Then GoTo No
If MSG1 = vbYes Then GoTo Yes
No:
  MsgBox "Please fill out the remaining missing information and then click Save & Email"
  Exit Sub
Yes:
  MsgBox "Thank you, please proceed"


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


' Check for year folder and create if needed


If Len(Dir(strGenericFilePath & strYearSlash, vbDirectory)) = 0 Then
    MkDir strGenericFilePath & strYearSlash
End If


' Check for month folder and create if needed


If Len(Dir(strGenericFilePath & strYearSlash & strMonthSlash, vbDirectory)) = 0 Then
    MkDir strGenericFilePath & strYearSlash & strMonthSlash
End If


' Saves as Excel Macro Enabled book


ActiveWorkbook.SaveAs strGenericFilePath & strYearSlash & strMonthSlash & strYearBracket & strMonthBracket & strFileName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled


' Popup Message that the conversion and save is complete as "YYYY_MM_Acquisition Title Procurement Request Form"


MsgBox "File Saved As:" & vbNewLine & strYearBracket & strMonthBracket & strFileName


' Enter Subject here (Using NamedRange)
StrSubject = Sheets("Acquisition").Range("AcquisitionTitle") & " Acquisition Request Form"


' Enter content of Email here
StrBody = "Please see attached File," & "<BR><BR><BR>" & vbNewLine & "Please list any additional details that I should know here that aren't listed on the form" & _
"<br><br><br> Thanks,"


' Code that attaches the Document to the email
StrAtt = ActiveWorkbook.FullName


' Who the email will be sent to
StrTo = "EMAIL ADDRESS"


' Adds Company Signature to the end of the Email. No Signature without this code
  With OutMail
  .Display
  End With
    StrSignature = OutMail.Body


With OutMail
    .To = StrTo
    .CC = ""
    .BCC = ""
    .Subject = StrSubject
    .HTMLBody = StrBody & .HTMLBody & vbNewLine & vbNewLine
    .Attachments.Add StrAtt
    .Display
  ' .Send (Not active, otherwise it will automatically send the email without review)
End With


On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing


End Sub
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Use Application.Pathseparator to get the correct character.
 
Upvote 0
Store it in a variable and use that in place of the slashes. Different Mac versions use different separators, so it’s the only way!
 
Upvote 0
Can you please provide an example? I'm not an expert in Excel VBA so not sure what you mean by "store it in a variable"
 
Upvote 0
Like this:

Code:
Dim pathsep as string
pathsep = application.pathseparator

then instead of this:

Code:
strYearSlash = Year(Date) & "\"

use this:

Code:
strYearSlash = Year(Date) & pathsep
 
Last edited:
Upvote 0
So as an example, if I have a Filepath of:

StrGenericFilePath = "\\company.org\folder1\folder2\folder3"
strYearSlash = Year(Date) & ""
strMonthSlash = CStr(Format(DateAdd("M", 0, Date), "MM")) & ""

How would I work in that into:

ActiveWorkbook.SaveAs strGenericFilePath & strYearSlash & strMonthSlash

It saves the file on our companies drive so I need the Mac and PC users to be able to save in the same location which is the Generic File Path String.
Or would it better/easier to have it save on a users Desktop? I'm just trying to make it the most error proof so if saving on the desktop is easier if someone has issues having access to the drive, I'd think the Desktop save would be better

Appreciate your assistance!
 
Upvote 0

Forum statistics

Threads
1,223,905
Messages
6,175,297
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top