Solved

Microsoft Access 2010 Send Email works but need formatting help

Posted on 2014-02-06
13
442 Views
Last Modified: 2014-02-06
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.
0
Comment
Question by:marlind605
  • 8
  • 5
13 Comments
 
LVL 26

Expert Comment

by:MacroShadow
ID: 39838715
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

0
 

Author Comment

by:marlind605
ID: 39838761
 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.
0
 

Author Comment

by:marlind605
ID: 39838775
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
0
 
LVL 26

Expert Comment

by:MacroShadow
ID: 39838808
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))?
0
 

Author Comment

by:marlind605
ID: 39838872
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.
0
 

Author Comment

by:marlind605
ID: 39838904
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.
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 
LVL 26

Expert Comment

by:MacroShadow
ID: 39838975
If we can see your full code, we will be able to assist you better.
0
 

Author Comment

by:marlind605
ID: 39838998
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

0
 
LVL 26

Expert Comment

by:MacroShadow
ID: 39839107
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

0
 

Author Comment

by:marlind605
ID: 39839214
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

0
 
LVL 26

Accepted Solution

by:
MacroShadow earned 500 total points
ID: 39839898
The only thing I could think of is using html in the email. Try this and see if it works.

Option Explicit

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

    Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl4pmAdministrator")
    Set olApp = CreateObject("Outlook.Application")
    SenderDetails = olApp.Session.CurrentUser
    Subject = "Administrator Auto-Notification"
    strSender = "marlind605"
    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

        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

End Sub

Function Filler(strInput As String, intDateLen As Integer, Optional intDesiredLength As Integer = 40) As String

    Const strColon As String = ";"

    Dim strTemp As String
    Dim intLength As Integer

    intLength = intDesiredLength - intDateLen
    strTemp = strInput

    Do Until Len(strTemp) >= intLength
        strTemp = strTemp & " "
        If Len(strTemp) = intLength - 1 Or Len(strTemp) >= intLength Then
            Exit Do
        End If
        strTemp = strTemp & strColon
        If Len(strTemp) = intLength - 1 Or Len(strTemp) >= intLength Then
            Exit Do
        End If
    Loop

    Filler = Replace(strTemp, ";", "&nbsp;")

End Function

Open in new window

0
 

Author Comment

by:marlind605
ID: 39840191
Sub Demo()

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

    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.
0
 

Author Closing Comment

by:marlind605
ID: 39840195
This took great effort. I need to file this code away for future use. Thanks MacrowShadow
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

Article by: Leon
Software Metering within our group of companies has always been an afterthought until auditing of software and licensing became a pain point. Orchestrator and SCCM metering gave us the answer and it was an exciting process.
Outlook Free & Paid Tools
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now