I have wrote the following code in VBA.
note: forget the button
the code works half its checking when the fields are filled then it will not go end send the email???
please help me on this
Sub SendWorkBook()
'Update 20171227
Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim FilePath As String
Dim FileName As String
Dim rng As Range
Dim cel As Range
Dim iBlank As Integer
Dim OutLookApp As Object
Dim OutlookMail As Object
On Error Resume Next
'check cells before sending
Set rng = SheetNL.Range("B5,B6,B11,C16,D42,H6,H8,H9,J18")
For Each cel In rng
If cel.Value = "" Then iBlank = iBlank + 1
Next cel
If iBlank > 0 Then 'something is blank
Call MsgBox("Please complete all red fields before sending.", vbOKOnly + vbCritical, "Missing Info")
Else
Application.ScreenUpdating = False
Set Wb = Application.ActiveWorkbook
ActiveBook.Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Case Excel8:
xFile = ".xls"
xFormat = Excel8
Case xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & ""
FileName = Wb.Name & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutLookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutLookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
With OutlookMail
.To = "test@test
.com"
.CC = ""
.BCC = ""
.Subject = "test"
.Body = "test"
.Attachments.Add Wb2.FullName
.Send
'Display
End With
On Error GoTo 0
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutLookApp = Nothing
Application.ScreenUpdating = True
End If
End Sub
