Hi there,
I have a beforesave macro that checks for any missing data that is required. It has message boxes that pop up and such to let users know they are missing data. I also have a mail macro where the user can press a submit button and it prompts the workbook to mail out. Obviously this mail macro does not have any sort of validation to check whether the required values are actually present. Is there any way i can call the beforesave macro into the mail macro?
Code for Beforesave (In Workbook module)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim myArr() As Variant
Dim i As Integer, x As Integer
Dim icell As Range, xcell As Range, rng1 As Range, rng2 As Range
Dim iMsg
myArr = Array("WO1", "WO2", "WO3", "WO4", "WO5")
On Error Resume Next
For i = 0 To 4
Set rng1 = Union(Sheets(myArr(i)).Range("C26:C33"), Sheets(myArr(i)).Range("I26:I33"), Sheets(myArr(i)).Range("O26:O33"))
For Each icell In rng1
Select Case icell.Column
Case Is = 3
If Not IsEmpty(icell) Then
If IsEmpty(icell.Offset(0, 1)) Then
iMsg = MsgBox("Error. Please enter Yes/No for 'Customer Spare Part' in cell '" & icell.Offset(0, 1).Address & "' in section A of " & Sheets(myArr(i)).Name & _
vbNewLine & " Would you like to see the part number?", vbYesNo Or vbExclamation, "Missing Information!")
Cancel = True
End If
If iMsg = vbYes Then
MsgBox (icell.Value)
End If
End If
Case Is = 9
If Not IsEmpty(icell) Then
If IsEmpty(icell.Offset(0, 1)) Then
iMsg = MsgBox("Error. Please enter Yes/No for 'Customer Spare Part' in cell '" & icell.Offset(0, 1).Address & "' in section B of " & Sheets(myArr(i)).Name & _
vbNewLine & " Would you like to see the part number?", vbYesNo Or vbExclamation, "Missing Information!")
Cancel = True
End If
If iMsg = vbYes Then
MsgBox (icell.Value)
End If
End If
Case Is = 15
If Not IsEmpty(icell) Then
If IsEmpty(icell.Offset(0, 1)) Then
iMsg = MsgBox("Error. Please enter Yes/No for 'Customer Spare Part' in cell '" & icell.Offset(0, 1).Address & "' in section C of " & Sheets(myArr(i)).Name & _
vbNewLine & " Would you like to see the part number?", vbYesNo Or vbExclamation, "Missing Information!")
Cancel = True
End If
If iMsg = vbYes Then
MsgBox (icell.Value)
End If
End If
End Select
Next icell
Next i
For x = 0 To 4
Set rng2 = Union(Sheets(myArr(x)).Range("E17"), Sheets(myArr(x)).Range("K17"), Sheets(myArr(x)).Range("R17"), Sheets(myArr(x)).Range("V17"))
For Each xcell In rng2
Select Case xcell.Column
Case Is = 5
If Not IsEmpty(xcell) Then
If IsEmpty(Sheets(myArr(x)).Range("C38")) Then
MsgBox "Please Enter a comment for Section A of " & Sheets(myArr(x)).Name
Cancel = True
End If
End If
Case Is = 11
If Not IsEmpty(xcell) Then
If IsEmpty(Sheets(myArr(x)).Range("C42")) Then
MsgBox "Please Enter a comment for Section B of " & Sheets(myArr(x)).Name
Cancel = True
End If
End If
Case Is = 18
If Not IsEmpty(xcell) Then
If IsEmpty(Sheets(myArr(x)).Range("C46")) Then
MsgBox "Please Enter a comment for Section C of " & Sheets(myArr(x)).Name
Cancel = True
End If
End If
Case Is = 22
If Not IsEmpty(xcell) Then
If IsEmpty(Sheets(myArr(x)).Range("C50")) Then
MsgBox "Please enter a comment for section D of " & Sheets(myArr(x)).Name
Cancel = True
End If
End If
End Select
Next xcell
Next x
End Sub
Mail Macro (In Module 1)
Sub Mail_WO()
'Working in 2000-2010
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Call CheckData
'Determine the Excel version and file extension/format
With Sourcewb
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2010, we exit the sub when your answer is
'NO in the security dialog that you only see when you copy
'an sheet from a xlsm file with macro's disabled.
'If Sourcewb.Name = .Name Then
'With Application
' .ScreenUpdating = True
' .EnableEvents = True
' End With
' MsgBox "Your answer is NO in the security dialog"
' Exit Sub
' Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
'End If
End If
End With
'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = Sheets("WO1").Range("E10").Value & " - " & Sheets("WO1").Range("W5").Text & " " & "Work Order - " & Sheets("WO1").Range("Site").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Sourcewb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = ""
.CC = Sheets("WO1").Range("E54").Value
.BCC = ""
.Subject = Sheets("WO1").Range("W5").Value & " Work Order" & " - " & Sheets("WO1").Range("Site").Value
.Body = "Please find attached work order for " & Sheets("WO1").Range("W5").Value
.Attachments.Add Sourcewb.FullName
.Display 'or use .Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Any help is appreciated.
Thanks!
Bookmarks