mattmcclements
New Member
- Joined
- Apr 15, 2022
- Messages
- 36
- Office Version
- 2016
- Platform
- Windows
This is a silly question but how do you write time in terms of vba email coding. My spreadsheet generates an automatic email and in the body it will detail the how many minutes late someone was. But how do you get it to write 2 minutes and not 1.38888888888888E-03 minutes? This is the current code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByDate As String
Dim ByDate1 As String
Dim ByDate2 As String
Dim ByDate3 As String
On Error Resume Next
If Intersect(Range("K2:K1000"), Target) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If IsNumeric(Target.Value) Then
If Target.Value >= 3 Then
MailAddress = Range("M" & Target.Row).Value
ByDate = (Cells(Target.Row, "A"))
ByDate1 = (Cells(Target.Row, "C"))
ByDate2 = (Cells(Target.Row, "G"))
ByDate3 = (Cells(Target.Row, "K"))
Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByDate, ByDate1, ByDate2, ByDate3)
' Send the email
emailItem.Send
End If
End If
End Sub
Sub Mail_small_Text_Outlook(MailAddress As String, MailAddress_CC As String, ByDate As String, ByDate1 As String, ByDate2 As String, ByDate3 As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim cell As Range
Dim strbody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
On Error Resume Next
With xOutMail
.To = MailAddress
.Cc = ""
.BCC = ""
.Subject = "Driver Errors Investigation"
.htmlBody = "Hi," & vbNewLine & vbNewLine & "you have a lates investigation to complete on " & ByDate & " who was late on " & ByDate1 & " by " & ByDate2 & " minutes, this is their " & ByDate3 & " offence."
.Display
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Check_Offences()
Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByDate As String
DimLr As Long
Dim r As Long
On Error Resume Next
With Sheets("Lates")
'Get last row
Lr = .Range("A" & .Rows.Count).End(xlUp).Row
For Each cell In .Range("J2:J" & Lr)
If IsNumeric(cell) And cell >= 3 And Not cell.Offset(0, 2) = "Y" Then '<<< Assumes 'Email Sent' Confirmation Y' ' in column L <<< ???(Offset 2)
r = cell.Row
MailAddress = .Range("M" & r).Value
MailAddress_CC = .Range("" & r).Value
'String of Date in C '??
ByDate = CDate(.Range("C" & r))
Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByDate) '<<<<<<
' Send the email
emailItem.Send
'Mark email as Sent in column L <<<< ?????
.Range("L" & r) = "Y"
Else
End If
Any help would be greatly appreciated
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByDate As String
Dim ByDate1 As String
Dim ByDate2 As String
Dim ByDate3 As String
On Error Resume Next
If Intersect(Range("K2:K1000"), Target) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If IsNumeric(Target.Value) Then
If Target.Value >= 3 Then
MailAddress = Range("M" & Target.Row).Value
ByDate = (Cells(Target.Row, "A"))
ByDate1 = (Cells(Target.Row, "C"))
ByDate2 = (Cells(Target.Row, "G"))
ByDate3 = (Cells(Target.Row, "K"))
Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByDate, ByDate1, ByDate2, ByDate3)
' Send the email
emailItem.Send
End If
End If
End Sub
Sub Mail_small_Text_Outlook(MailAddress As String, MailAddress_CC As String, ByDate As String, ByDate1 As String, ByDate2 As String, ByDate3 As String)
Dim xOutApp As Object
Dim xOutMail As Object
Dim cell As Range
Dim strbody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
On Error Resume Next
With xOutMail
.To = MailAddress
.Cc = ""
.BCC = ""
.Subject = "Driver Errors Investigation"
.htmlBody = "Hi," & vbNewLine & vbNewLine & "you have a lates investigation to complete on " & ByDate & " who was late on " & ByDate1 & " by " & ByDate2 & " minutes, this is their " & ByDate3 & " offence."
.Display
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Sub Check_Offences()
Dim MailAddress As String
Dim MailAddress_CC As String
Dim ByDate As String
DimLr As Long
Dim r As Long
On Error Resume Next
With Sheets("Lates")
'Get last row
Lr = .Range("A" & .Rows.Count).End(xlUp).Row
For Each cell In .Range("J2:J" & Lr)
If IsNumeric(cell) And cell >= 3 And Not cell.Offset(0, 2) = "Y" Then '<<< Assumes 'Email Sent' Confirmation Y' ' in column L <<< ???(Offset 2)
r = cell.Row
MailAddress = .Range("M" & r).Value
MailAddress_CC = .Range("" & r).Value
'String of Date in C '??
ByDate = CDate(.Range("C" & r))
Call Mail_small_Text_Outlook(MailAddress, MailAddress_CC, ByDate) '<<<<<<
' Send the email
emailItem.Send
'Mark email as Sent in column L <<<< ?????
.Range("L" & r) = "Y"
Else
End If
Any help would be greatly appreciated