Link to home
Start Free TrialLog in
Avatar of marlind605
marlind605Flag for United States of America

asked on

Microsoft Access 2010 Send Email works but need formatting help

I need to fix the spacing for the report date. If the first and Last Name is shorter or longer the report date is not aligned in the email.
I use this to send out my email
Body = Body & (vbCrLf & rs("First Name") & " " & rs("Last Name") & vbTab) & Trim(vbTab & rs("ReportDate"))

John Doe                                          2/1/2014
Roger Longname                                    2/1/2014
Joe Doe                                                2/2/2014

I want the date to be left justified. Lined up under each other. Thanks.
Avatar of Joe Howard
Joe Howard
Flag of United States of America image

Try this.
First it determines the length of the actual text from the recordset, next it adds enough blank spaces after the first and last names to reach the total length which you've set on the first line of this snippet.

    Const intTotalLength As Integer = 50 ' Here you define the total length you want each line to be
    
    Dim strTemp As String
    
    strTemp = rs("First Name") & " " & rs("Last Name") & " " & rs("ReportDate")
    Body = Body & rs("First Name") & " " & rs("Last Name") & String(intTotalLength - Len(strTemp), " ") & rs("ReportDate")

Open in new window

Avatar of marlind605

ASKER

 strTemp = rs("First Name") & " " & rs("Last Name") & " " & rs("ReportDate")
    Body = Body & vbCrLf & rs("First Name") & " " & rs("Last Name") & String(intTotalLength - Len(strTemp), " ") & rs("ReportDate")

Open in new window

I added a vbcrlf and it still does not line up. I see what your idea is but just not doing it.
User                    Date(s) in Question
__________________________________
Bob Jones                    2/5/2014
Bob Jones                    2/5/2014
Eric Payne                   2/5/2014
Ella Little                  2/5/2014
Bob Jones                    2/5/2014
Brian Mcqueen                2/5/2014
Jean Faust                   2/5/2014
George Stephens              2/5/2014
Roger Mudd                   2/5/2014
Lee Majors                   2/5/2014
Dustin Roberts               2/5/2014
Stephen Wilkerson            2/5/2014
Jimmy Jones                  2/5/2014
Were does it show-up like that?

What happens if you use any other character instead of the space?

What happens if you use chr(32) instead on the space, i.e. String(intTotalLength - Len(strTemp), Chr(32))?
The report needs to start up at a specific space.  I am trying to make it start the reportdate on a specific spot each time I have tried several things in related to your suggestion but still varies with the length of the first name last name.
Body = Body & vbCrLf & rs("First Name") & " " & rs("Last Name") & String(intTotalLength - Len(strTemp), Chr(32)) & rs("ReportDate") & vbCrLf

Open in new window

That's not working either. Thanks for helping.
If we can see your full code, we will be able to assist you better.
Dim rs As DAO.Recordset
Dim olApp As Outlook.Application
Dim i%, Body$, Recipient$, Attachment$, Subject$
Dim strsender As String
 Dim strTemp As String
 Dim myspot As Integer
 myspot = 0
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl4pmAdministrator")
Set olApp = CreateObject("Outlook.Application")
strsender = "marlind605"
   Const intTotalLength As Integer = 40 ' Here you define the total length you want each line to be
    SenderDetails = olApp.Session.CurrentUser
    Set olApp = CreateObject("Outlook.Application")
    SenderDetails = olApp.Session.CurrentUser
    i = InStr(1, SenderDetails, ",", vbTextCompare)

                SenderDetails = Trim(Mid(SenderDetails, i + 1, Len(SenderDetails) - i))
  
                Recipient = "myemail.all.com"
                If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
              
                Body = Body & "This is an Administrator Auto-Notification to relay that a User Auto-Notification was sent to the individual(s) for specific dates reflected below, but the system does not detect the relevent time entries have been authenticated at this time. " & vbCrLf
                 Body = Body & "User" & vbTab & vbTab & vbTab & "Date(s) in Question" & vbCrLf
                 Body = Body & "__________________________________"
                 
    Do Until rs.EOF = True
          
   Body = Body & vbCrLf & rs("First Name") & " " & rs("Last Name") & String(intTotalLength - Len(strTemp), " ") & rs("ReportDate")
                 
       rs.MoveNext
       
    Loop


                Subject = "Administrator Auto-Notification"
                Attachment = "Full path of whatever file you want to attach"
                With olApp.CreateItem(olMailItem)
                        .Subject = Subject
                        .Body = Body
                        .To = Recipient
                       ' .Attachment.Add Attachment
                        .send

                End With
        Dim o As Outlook.MailItem
        Set olApp = Nothing
      '  rs.MoveNext
 
    
    Else
          MsgBox "There are no records in the recordset."
    End If

'MsgBox "Finished looping through records."

rs.Close 'Close the recordset

Open in new window

You don't set the length of the actual text. Both lines I posted should be in your loop:
        Do Until rs.EOF = True
        
            strTemp = rs("First Name") & " " & rs("Last Name") & " " & rs("ReportDate")
            Body = Body & vbCrLf & rs("First Name") & " " & rs("Last Name") & String(intTotalLength - Len(strTemp), " ") & rs("ReportDate")

            rs.MoveNext

        Loop

Open in new window


Also
Body = Body & "User" & vbTab & vbTab & vbTab & "Date(s) in Question" & vbCrLf

Open in new window

should read:
Body = Body & "User" String(intTotalLength - Len("UserDate(s) in Question"), " ")  & "Date(s) in Question" & vbCrLf

Open in new window

Still not working.
User                    Date(s) in Question
__________________________________
Bob Jones                      2/5/2014
Bob Jones                      2/5/2014
Eric Payne                     2/5/2014
Ella Little                    2/5/2014
Bob Jones                      2/5/2014
Brian Mcqueen                  2/5/2014
Jean Faust                     2/5/2014
George Stephens                2/5/2014
Roger Mudd                     2/5/2014
Lee Majors                     2/5/2014
Dustin Roberts                 2/5/2014
Stephen Wilkerson              2/5/2014
Jimmy Jones                    2/5/2014

Does the font matter?
Dim rs As DAO.Recordset
Dim olApp As Outlook.Application
Dim i%, Body$, Recipient$, Attachment$, Subject$
Dim strsender As String
 Dim strTemp As String
 Dim myspot As Integer
 myspot = 0
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl4pmAdministrator")
Set olApp = CreateObject("Outlook.Application")
strsender = "marlind605"
   Const intTotalLength As Integer = 40 ' Here you define the total length you want each line to be
    SenderDetails = olApp.Session.CurrentUser
    Set olApp = CreateObject("Outlook.Application")
    SenderDetails = olApp.Session.CurrentUser
    i = InStr(1, SenderDetails, ",", vbTextCompare)

                SenderDetails = Trim(Mid(SenderDetails, i + 1, Len(SenderDetails) - i))
  
                Recipient = "mark.gibson@bpldatabase.com"
                If Not (rs.EOF And rs.BOF) Then
    rs.MoveFirst 'Unnecessary in this case, but still a good habit
              
                Body = Body & "This is an Administrator Auto-Notification to relay that a User Auto-Notification was sent to the individual(s) for specific dates reflected below, but the system does not detect the relevent time entries have been authenticated at this time. " & vbCrLf
                 Body = Body & "User" & vbTab & vbTab & vbTab & "Date(s) in Question" & vbCrLf
                 Body = Body & "__________________________________"
        Do Until rs.EOF = True
        
            strTemp = rs("First Name") & " " & rs("Last Name") & " " & rs("ReportDate")
            Body = Body & vbCrLf & rs("First Name") & " " & rs("Last Name") & String(intTotalLength - Len(strTemp), " ") & rs("ReportDate")

            rs.MoveNext

        Loop


                Subject = "Administrator Auto-Notification"
                Attachment = "Full path of whatever file you want to attach"
                With olApp.CreateItem(olMailItem)
                        .Subject = Subject
                        .Body = Body
                        .To = Recipient
                         ' .Attachment.Add Attachment
                        .send

                End With
        Dim o As Outlook.MailItem
        Set olApp = Nothing
      '  rs.MoveNext
 
    
    Else
          MsgBox "There are no records in the recordset."
    End If

'MsgBox "Finished looping through records."

rs.Close 'Close the recordset

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Joe Howard
Joe Howard
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Sub Demo()

    Const intDesiredLength As Integer = 40    ' Here you define the total length you want each line to be
    Const strNoBreakSpace As String = "  "

    Dim rs As DAO.Recordset
    Dim olApp As Outlook.Application
    Dim i As Integer
    Dim Recipient As String
    Dim Subject As String
    Dim strsender As String
    Dim strHTML As String
 'SenderDetails = Trim(Mid(SenderDetails, i + 1, Len(SenderDetails) - i))
    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl4pmAdministrator")
    Set olApp = CreateObject("Outlook.Application")
     'SenderDetails = olApp.Session.CurrentUser
    Subject = "Administrator Auto-Notification"
  '  i = InStr(1, SenderDetails, ",", vbTextCompare)
     Recipient = "myemail@anything.com"

    If Not (rs.EOF And rs.BOF) Then
        rs.MoveFirst    'Unnecessary in this case, but still a good habit

        strHTML = "<html>" & vbLf & "<head><title>Administrator Auto-Notification</title></head>" & vbLf & "<body>" & vbLf & "<pre class=""code prettyprint"">" & vbLf

        strHTML = strHTML & "This is an Administrator Auto-Notification to relay that a User Auto-Notification" & vbCr
        strHTML = strHTML & "was sent to the individual(s) for specific dates reflected below, but the system" & vbCr
        strHTML = strHTML & "does not detect the relevent time entries have been authenticated at this time." & vbCr

        Do Until rs.EOF = True
           ' strHTML = strHTML & "<br>" & rs("First Name") & " " & rs("Last Name")
            strHTML = strHTML & "<br>" & Filler(rs("First Name") & " " & rs("Last Name"), Len(rs("ReportDate")))
            strHTML = strHTML & rs("ReportDate") '& vbCr
            rs.MoveNext
        Loop

        strHTML = strHTML & "</code></code></code></pre></body>" & vbCr & "</html>"

        With olApp.CreateItem(olMailItem)
            .Subject = Subject
            .BodyFormat = olFormatHTML
            .HTMLBody = strHTML
            .To = Recipient
            .send
        End With

    Else
        MsgBox "There are no records in the recordset."
    End If

    'MsgBox "Finished looping through records."

    rs.Close    'Close the recordset
    Set rs = Nothing
    Set olApp = Nothing

Open in new window

I had to make some changes but it worked. This is the final code. You stuck with me. Thanks.
This took great effort. I need to file this code away for future use. Thanks MacrowShadow