Armygeddan
Board Regular
- Joined
- Apr 6, 2016
- Messages
- 79
I have a Form I have my company use and some users use Macs but most use PC. The VBA below works 100% fine with PC users but since Mac's have a few different variances when it comes to File Path's I'm running into an issue of them using my form to save the file when clicking a button assigned with VBA.
Please note that I am trying Application.OperatingSystem code on Lines 37 and 94 but for some reason it still runs the entire code for Mac users while completely ignoring my If Statement for Operating System and reads it as PC
Here's what I have currently have:
Please note that I am trying Application.OperatingSystem code on Lines 37 and 94 but for some reason it still runs the entire code for Mac users while completely ignoring my If Statement for Operating System and reads it as PC
Here's what I have currently 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 = "\\corp.company\folder1\folder2\folder3\"
Dim strOSGenericFilePath As String: strOSGenericFilePath = "~/Documents"
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"
Dim TheOS As String: TheOS = Application.OperatingSystem
' 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)
' VBA Command for Windows Users
If Left(TheOS, 1) = "W" Then
' Check for Year Folder in V Drive and creates one if one doesn't exist
If Len(Dir(strGenericFilePath & strYearSlash, vbDirectory)) = 0
Then
MkDir strGenericFilePath & strYearSlash
End If
' Check for Month Folder in V Drive and creates one if one doesn't exist
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 = "YOUREMAIL@COMPANY.COM"
' 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 once user clicks Save & Email Button)
End With
' VBA Command for Mac Users
ElseIf Left(TheOS, 1) = "M" Then
' Saves as Excel Macro Enabled book
ActiveWorkbook.SaveAs strOSGenericFilePath & strFileName & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
' Popup Message that the conversion and save is complete as "Acquisition Title Procurement Request Form"
MsgBox "File Saved As in your Documents Folder:" & vbNewLine & 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 = "YOUREMAIL@COMPANY.COM"
' 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 once user clicks Save & Email Button)
End With
End If
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
