I included my VBA below. I would like to change the font of the
"strBody" to be Bold, italic, color, etc. The code that I attempted to
write is identified by ***. Any help would be appreciated.
------------------------------------------------
Private Sub EmlAll_Click()
On Error GoTo Err_EmlAll_Click
Dim strBody As String
Dim rs As Object
Dim con As Object
Dim DateEnter As Date
Dim NoMeetings As Integer
Dim Meeting(100) As Integer
Dim i As Integer
Dim j As Integer
Dim Room As String
***Dim fontheader As StdFont
***Dim bold As Boolean
***Dim name As String
***fontheader.bold = True
***fontheader.name = "Arial"
i = 0
j = 0
If Not IsNull(Me![DateEnter]) Then
'this is an sql string to search by date. You'll need to change the name
to fit your database.
sqlst = "Select Distinct MeetingID " _
& "From MeetingData " _
& "WHERE ((MeetingData.MeetingDate) = #" & Me![DateEnter] & "#)"
Set con = Application.CurrentProject.Connection
Set rs = CreateObject("ADODB.recordset")
rs.Open sqlst, con, 1
If Not rs.EOF Then
While Not rs.EOF
Meeting(i) = rs![MeetingID]
i = i + 1
rs.MoveNext
Wend
Else
MsgBox ("No meetings on this date") 'this is your msgbox for the
user to enter the date.
Exit Sub
End If
rs.Close
***Set fontheader.font = strBody
strBody = "Port Assignments: " & Format(Me![DateEnter], "Long Date") &
vbCr
For j = 0 To i
'the following is a sql string that you will need to edit according to
your needs. Enter sql string
'after the sqlst=. There was a problem with carriage returns so leave
undercores in after each line along with ampersands
sqlst = "SELECT MeetingData.MeetingTitle, MeetingData.MeetingDate, " _
& "MeetingData.Description, MeetingData.SetupTime, " _
& "MeetingData.StartTime,MeetingData.EndTime, [Usage].TimeID, " _
& "[Usage].Port,[Usage].DialUpNo " _
& "FROM MeetingData Left JOIN [Usage] ON " _
& "MeetingData.MeetingID=[Usage].MeetingID " _
& "WHERE ((MeetingData.MeetingID) = " & Meeting(j) & ")"
'Set con = Application.CurrentProject.Connection
'Set rs = CreateObject("ADODB.recordset")
rs.Open sqlst, con, 1
If Not rs.EOF Then
strBody = strBody & vbCr
strBody = strBody &
"-------------------------------------------------------------" & vbCr
strBody = strBody & "Subject: " & rs![MeetingTitle] & vbCr
strBody = strBody &
"-------------------------------------------------------------" & vbCr
strBody = strBody & "Setup Time: " & vbTab & Format(TimeSerial(3, 0,
0) + rs![SetupTime], "Short Time") & " E " & Format(TimeSerial(2, 0, 0)
+ rs![SetupTime], "Short Time") & " C " & Format(TimeSerial(1, 0, 0) +
rs![SetupTime], "Short Time") & " M " & Format(rs![SetupTime], "Short
Time") & " P " & vbCr
strBody = strBody & "Start Time: " & vbTab & Format(TimeSerial(3, 0,
0) + rs![StartTime], "Short Time") & " E " & Format(TimeSerial(2, 0, 0)
+ rs![StartTime], "Short Time") & " C " & Format(TimeSerial(1, 0, 0) +
rs![StartTime], "Short Time") & " M " & Format(rs![StartTime], "Short
Time") & " P " & vbCr
strBody = strBody & "End Time: " & vbTab & Format(TimeSerial(3, 0,
0) + rs![EndTime], "Short Time") & " E " & Format(TimeSerial(2, 0, 0) +
rs![EndTime], "Short Time") & " C " & Format(TimeSerial(1, 0, 0) +
rs![EndTime], "Short Time") & " M " & Format(rs![EndTime], "Short
Time") & " P " & vbCr
strBody = strBody & "Description:" & rs![Description] & vbCr & vbCr
strBody = strBody & "Participants" & vbTab & "Port Number" & vbTab &
"Dial Number" & vbCr
While Not rs.EOF
If IsNull(rs![TimeID]) Then
Room = ""
Else
Room = DLookup("RoomName", "TimeCard", "[TimeID] = " &
rs![TimeID])
End If
strBody = strBody & Room & vbTab & vbTab & rs![PortID] & vbTab &
rs![DialUpNo] & vbCr
rs.MoveNext
Wend
strBody = strBody & vbCr & "" & vbCr
End If
rs.Close
Next j
'================================================= ======================
=====================================
'You can edit the myItem.Subject,.To, &.Cc within the quotations. The
myItem.Body refers to the strBody string above
'DO NOT delete the strBody. In the myItem.To, you can input actual
email addresses seperated by a semicolin or exchange name
'================================================= ======================
=====================================
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.createitem(0)
myItem.Subject = "Port Assignments" 'enter your email subject line
here
myItem.Body = strBody
myItem.To = "" 'enter your destination email here
myItem.Cc = ""
myItem.display
Set rs = Nothing
Else
MsgBox ("Please enter a date") 'this is your error msgbox if no date is
entered. you can change this message if you'd like
End If
Exit_EmlAll_Click:
Exit Sub
Err_EmlAll_Click:
MsgBox Err.Description
Resume Exit_EmlAll_Click
End Sub
-------------------------------------------------------
Forgive me...I'm a beginner programmer with expert expectations.
*** Sent via Developersdex http://www.developersdex.com ***
