how to transfer data from excel into outlook in controled columns
Hi
i have the following code that send an email (outlook)with various cell data depending on due date
is there a way to make sure the data transfered and shown in the email is spaced out evenly i.e.
all the names , descrition, due date etc will always be rendered in colunms so the email looks right?
at the moment i have tried to space them in the code but if a name is longer in one cell it pushes everthing out and it makes the email look messy and hard to read
if this should be in the excel forum could you let me know and i will move it
cheers peter
Code:
Private Sub Workbook_Open()
Dim rng As Range
Dim c As Variant
Dim ddiff As Long
Dim mdiff As Long
Dim fso As Object
Dim oOutlook As Object
Dim oMail As Object
Dim body As String
Sheets("ppe").Select
' Set the range of PPE dates to check
Set rng = Range("F7:F50" & Range("F" & Rows.Count).End(xlUp).Row - 1)
' Set the initial email body. We will use this to check if we have issues later.
body = "The Following items are Due or Overdue Inspection" & ": " & Chr(9) & Chr(9) & Chr(9) & vbCrLf & vbCrLf & vbCrLf
For Each c In rng
' If each value in the range is a date, then do a check for months and days.
If IsDate(c.Value) Then
ddiff = DateDiff("d", Now(), c.Value)
mdiff = DateDiff("m", Now(), c.Value)
' If greater than 1 month away, only populate the cell, do not add to the email
' body. You many want to change this.
If ddiff > 0 Then
c.Offset(0, 4).Value = ddiff & " Days from now"
Else
' Else, if we have less than one month, use days as the indicator, and
' increment the email body.
If ddiff > 1 Then
c.Offset(0, 4).Value = ddiff & " days from now"
body = body & c.Offset(0, -4) & ": " & Chr(9) & c.Offset(0, -3) & Chr(9) & Chr(9) & Chr(9) & ddiff & " days from now" & vbCrLf
Else
If ddiff = 0 Then
c.Offset(0, 4).Value = "due today"
body = body & c.Offset(0, -4) & ": " & Chr(9) & c.Offset(0, -5) & ": " & Chr(9) & Chr(9) & c.Offset(0, -3) & ": " & Chr(9) & c.Offset(0, -1) & ": " & Chr(9) & " due today" & ": " & vbCrLf
Else
c.Offset(0, 4).Value = ddiff * -1 & " days overdue"
body = body & c.Offset(0, -4) & ": " & Chr(9) & c.Offset(0, -5) & ": " & Chr(9) & c.Offset(0, -3) & ": " & Chr(9) & c.Offset(0, -1) & ": " & Chr(9) & ddiff * -1 & " days overdue" & ": " & vbCrLf
End If
End If
End If
End If
Next c
' If there is one we need to know about, send the email
If Len(body & "") > 0 Then
Set oOutlook = CreateObject("Outlook.Application")
Set oMail = oOutlook.createitem(0)
End If
With oMail
.To = "peter.renton@northside.co.uk "
.cc = "notner6000@yahoo.co.uk"
.Subject = "Northside Leeds ppe Safety Checks"
.body = body
.display
End With
Sheets("equipment").Select
' Set the range of PPE dates to check
Set rng = Range("F7:F50" & Range("F" & Rows.Count).End(xlUp).Row - 1)
' Set the initial email body. We will use this to check if we have issues later.
body = "The Following items are Due or Overdue Inspection" & ": " & Chr(9) & Chr(9) & Chr(9) & vbCrLf & vbCrLf & vbCrLf
For Each c In rng
' If each value in the range is a date, then do a check for months and days.
If IsDate(c.Value) Then
ddiff = DateDiff("d", Now(), c.Value)
mdiff = DateDiff("m", Now(), c.Value)
' If greater than 1 month away, only populate the cell, do not add to the email
' body. You many want to change this.
If ddiff > 0 Then
c.Offset(0, 4).Value = ddiff & " Days from now"
Else
' Else, if we have less than one month, use days as the indicator, and
' increment the email body.
If ddiff > 1 Then
c.Offset(0, 4).Value = ddiff & " days from now"
body = body & c.Offset(0, -1) & ": " & Chr(9) & c.Offset(0, -4) & Chr(9) & Chr(9) & Chr(9) & ddiff & " days from now" & vbCrLf
Else
If ddiff = 0 Then
c.Offset(0, 4).Value = "due today"
body = body & c.Offset(0, -1) & ": " & Chr(9) & Chr(9) & Chr(9) & c.Offset(0, -4) & ": " & Chr(9) & Chr(9) & Chr(9) & c.Offset(0, -3) & ": " & Chr(9) & Chr(9) & Chr(9) & " due today" & ": " & vbCrLf
Else
c.Offset(0, 4).Value = ddiff * -1 & " days overdue"
body = body & c.Offset(0, -1) & ": " & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & c.Offset(0, -4) & ": " & Chr(9) & Chr(9) & Chr(9) & Chr(9) & c.Offset(0, -3) & ": " & Chr(9) & Chr(9) & Chr(9) & Chr(9) & ddiff * -1 & " days overdue" & ": " & vbCrLf
End If
End If
End If
End If
Next c
' If there is one we need to know about, send the email
If Len(body & "") > 0 Then
Set oOutlook = CreateObject("Outlook.Application")
Set oMail = oOutlook.createitem(0)
End If
With oMail
.To = "peter.renton@northside.co.uk "
.cc = "notner6000@yahoo.co.uk"
.Subject = "Northside Leeds Equipment Safety Checks"
.body = body
.display
End With
Sheets("forktruck").Select
' Set the range of PPE dates to check
Set rng = Range("F7:F50" & Range("F" & Rows.Count).End(xlUp).Row - 1)
' Set the initial email body. We will use this to check if we have issues later.
body = "The Following items are Due or Overdue Inspection" & ": " & Chr(9) & Chr(9) & Chr(9) & vbCrLf & vbCrLf & vbCrLf
For Each c In rng
' If each value in the range is a date, then do a check for months and days.
If IsDate(c.Value) Then
ddiff = DateDiff("d", Now(), c.Value)
mdiff = DateDiff("m", Now(), c.Value)
' If greater than 1 month away, only populate the cell, do not add to the email
' body. You many want to change this.
If ddiff > 0 Then
c.Offset(0, 4).Value = ddiff & " Days from now"
Else
' Else, if we have less than one month, use days as the indicator, and
' increment the email body.
If ddiff > 1 Then
c.Offset(0, 4).Value = ddiff & " days from now"
body = body & c.Offset(0, -1) & ": " & Chr(9) & c.Offset(0, -4) & Chr(9) & Chr(9) & Chr(9) & ddiff & " days from now" & vbCrLf
Else
If ddiff = 0 Then
c.Offset(0, 4).Value = "due today"
body = body & c.Offset(0, -1) & ": " & Chr(9) & Chr(9) & Chr(9) & c.Offset(0, -4) & ": " & Chr(9) & Chr(9) & Chr(9) & c.Offset(0, -3) & ": " & Chr(9) & Chr(9) & Chr(9) & " due today" & ": " & vbCrLf
Else
c.Offset(0, 4).Value = ddiff * -1 & " days overdue"
body = body & c.Offset(0, -1) & ": " & Chr(9) & Chr(9) & Chr(9) & Chr(9) & Chr(9) & c.Offset(0, -4) & ": " & Chr(9) & Chr(9) & Chr(9) & Chr(9) & c.Offset(0, -3) & ": " & Chr(9) & Chr(9) & Chr(9) & Chr(9) & ddiff * -1 & " days overdue" & ": " & vbCrLf
End If
End If
End If
End If
Next c
' If there is one we need to know about, send the email
If Len(body & "") > 0 Then
Set oOutlook = CreateObject("Outlook.Application")
Set oMail = oOutlook.createitem(0)
End If
With oMail
.To = "peter.renton@northside.co.uk "
.cc = "notner6000@yahoo.co.uk"
.Subject = "Northside Leeds forktruck Safety Checks"
.body = body
.display
End With
End Sub
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://eileenslounge.com/viewtopic.php?p=320960#p320960
https://eileenslounge.com/viewtopic.php?p=320957#p3209573
https://eileenslounge.com/viewtopic.php?p=318868#p318868
https://eileenslounge.com/viewtopic.php?p=318311#p318311
https://eileenslounge.com/viewtopic.php?p=318302#p318302
https://eileenslounge.com/viewtopic.php?p=317704#p317704
https://eileenslounge.com/viewtopic.php?p=317704#p317704
https://eileenslounge.com/viewtopic.php?p=317857#p317857
https://eileenslounge.com/viewtopic.php?p=317541#p317541
https://eileenslounge.com/viewtopic.php?p=317520#p317520
https://eileenslounge.com/viewtopic.php?p=317510#p317510
https://eileenslounge.com/viewtopic.php?p=317547#p317547
https://eileenslounge.com/viewtopic.php?p=317573#p317573
https://eileenslounge.com/viewtopic.php?p=317574#p317574
https://eileenslounge.com/viewtopic.php?p=317582#p317582
https://eileenslounge.com/viewtopic.php?p=317583#p317583
https://eileenslounge.com/viewtopic.php?p=317605#p317605
https://eileenslounge.com/viewtopic.php?p=316935#p316935
https://eileenslounge.com/viewtopic.php?p=317030#p317030
https://eileenslounge.com/viewtopic.php?p=317030#p317030
https://eileenslounge.com/viewtopic.php?p=317014#p317014
https://eileenslounge.com/viewtopic.php?p=316940#p316940
https://eileenslounge.com/viewtopic.php?p=316927#p316927
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
