Results 1 to 1 of 1

Thread: how to transfer data from excel into outlook in controled columns

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Member
    Join Date
    May 2013
    Posts
    84
    Rep Power
    12

    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
    Last edited by DocAElstein; 10-04-2024 at 10:27 PM.

Similar Threads

  1. data transfer does not match up
    By jeff in forum Excel Help
    Replies: 18
    Last Post: 01-15-2014, 06:36 AM
  2. Replies: 2
    Last Post: 01-11-2014, 12:15 AM
  3. Replies: 6
    Last Post: 08-25-2013, 12:35 PM
  4. How To Move Transfer Or Copy Data To A Protected Sheet
    By rich_cirillo in forum Excel Help
    Replies: 7
    Last Post: 07-13-2013, 06:52 PM
  5. Excel to Excel Data transfer without opening any of the files(source or target)
    By Transformer in forum Excel and VBA Tips and Tricks
    Replies: 14
    Last Post: 08-22-2012, 10:57 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •