Hello All:
First off - I am learning a ton from those far more knowledgeable than I here on the forums.
My latest stumbling block
I have a Form (frmExamEmailStudent) with a field named ExamID
The information from this form needs to be inputted into an excel form and mailed off to those doing the registering of the exam.
Everything works fine with one exception.
When I create the excel spreadsheet it gives me all students where I only require ONE. So I need to bring the ExamID value from the form to my SQL and VBA statement.
My VBA code is below - where you see the number 1042 that is hard coded into the WHERE clause of the SQL statement - I need a way to bring the ExamID value to that spot.
Thanks in advance
Private Sub Export_to_Excel_Click()
On Error GoTo SubError
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim SQL As String
Dim rs1 As DAO.Recordset
Dim i As Integer
'Show user work is being performed
DoCmd.Hourglass (True)
'*********************************************
' RETRIEVE DATA
'*********************************************
'SQL statement to retrieve data from database
SQL = "SELECT Student.StudentID, [LastName] & ', ' & [FirstNames] AS StudentName, Exam.ExamDate, Exam.ExamTime, Exam.Attempt, " & _
"Student.DateofBirth, Student.Address, Student.City, Student.Prov, Student.PostalCode, Student.HomePhone, Student.CellPhone, " & _
"IIf(IsNull([CellPhone]),[HomePhone],[CellPhone]) AS Phone, Exam.ExamID, Instructors.Title, Instructors.Telephone, " & _
"Instructors.Fax, Instructors.email, Instructors.Instructor, Exam.InstructorID " & _
"FROM Student INNER JOIN (Instructors INNER JOIN Exam ON Instructors.InstructorID = Exam.InstructorID) ON Student.StudentID = Exam.StudentID " & _
"Where Exam.ExamID = 1042;"
'Execute query and populate recordset
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
'If no data, don't bother opening Excel, just quit
If rs1.RecordCount = 0 Then
MsgBox "No data selected for export", vbInformation + vbOKOnly, "No Data Exported"
GoTo SubExit
End If
'*********************************************
' BUILD SPREADSHEET
'*********************************************
'Create an instance of Excel and start building a spreadsheet
'Early Binding
Set xlApp = Excel.Application
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
xlBook.Application.DisplayAlerts = False
With xlSheet
.Name = "Sheet1"
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 11
'Set column widths
.Columns("A").ColumnWidth = 31.57
.Columns("B").ColumnWidth = 16.29
.Columns("C").ColumnWidth = 27.57
.Columns("D").ColumnWidth = 12.43
.Columns("E").ColumnWidth = 19.43
.Columns("F").ColumnWidth = 10.43
.Columns("G").ColumnWidth = 10.43
.Columns("H").ColumnWidth = 9.57
.Columns("I").ColumnWidth = 9.57
.Columns("J").ColumnWidth = 15.57
.Columns("K").ColumnWidth = 13.43
.Rows("1:3").RowHeight = 21
.Rows("4").RowHeight = 45
.Rows("5:24").RowHeight = 18
.Rows("25:33").RowHeight = 15
'Format columns
.Columns("B").NumberFormat = "yyyy-mmm-dd"
.Columns("J").NumberFormat = "dd-mmm-yyyy"
.Columns("K").NumberFormat = "h:mm AM/PM"
'build report heading
.Range("A1", "K1").Merge
.Range("A2", "K2").Merge
.Range("A3", "K3").Merge
.Range("A1").HorizontalAlignment = xlCenter
.Range("A2").HorizontalAlignment = xlCenter
.Range("A3").HorizontalAlignment = xlCenter
.Range("A1").Cells.Font.Bold = True
.Range("A2").Cells.Font.Bold = True
.Range("A3").Cells.Font.Bold = True
.Range("A1").Cells.Font.Name = "Calibri"
.Range("A2").Cells.Font.Name = "Calibri"
.Range("A3").Cells.Font.Name = "Calibri"
.Range("A1").Cells.Font.Size = 16
.Range("A2").Cells.Font.Size = 16
.Range("A3").Cells.Font.Size = 16
.Range("A1:K1").Interior.Color = RGB(82, 174, 86)
.Range("A2:K2").Interior.Color = RGB(197, 217, 241)
.Range("A3:K3").Interior.Color = RGB(197, 217, 241)
.Range("A1:K1").Font.Color = RGB(255, 255, 255)
.Range("A1").Value = "MANITOBA JUSTICE PISG EXAM BOOKING FORM"
.Range("A2").Value = "** Please note: Exams are booked on a first come, first serve basis. " & _
"If the time you have requested is not available you will be notified."
.Range("A3").Value = "** Exam fees must be paid 24 hours in advance and are non-refundable."
'build column headings
.Range("A4").Value = "LAST NAME, FIRST NAME"
.Range("B4").Value = "DATE OF BIRTH" & Chr(10) & "(year-month-day)"
.Range("C4").Value = "ADDRESS"
.Range("D4").Value = "POSTAL CODE"
.Range("E4").Value = "CITY"
.Range("F4").Value = "PROVINCE"
.Range("G4").Value = "40 hour" & Chr(10) & "course" & Chr(10) & "completed"
.Range("H4").Value = "Attempt #"
.Range("I4").Value = "French"
.Range("J4").Value = "EXAM DATE"
.Range("K4").Value = "EXAM TIME"
.Range("A4:K4").HorizontalAlignment = xlCenter
.Range("A4:K4").VerticalAlignment = xlCenter
.Range("A4:K4").Cells.Font.Bold = True
.Range("A4:K4").Cells.Font.Name = "Calibri"
.Range("A4:K4").Cells.Font.Size = 11
.Range("B5:B33").HorizontalAlignment = xlCenter
.Range("D5:K33").HorizontalAlignment = xlCenter
.Range("A1:K33").Borders(xlEdgeLeft).LineStyle = XlLineStyle.xlContinuous
.Range("A1:K33").Borders(xlEdgeRight).LineStyle = XlLineStyle.xlContinuous
.Range("A1:K33").Borders(xlEdgeTop).LineStyle = XlLineStyle.xlContinuous
.Range("A1:K33").Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
.Range("A1:K33").Borders(xlInsideVertical).LineSty le = XlLineStyle.xlContinuous
.Range("A1:K33").Borders(xlInsideHorizontal).LineS tyle = XlLineStyle.xlContinuous
'provide initial value to row counter
i = 5
'Loop through recordset and copy data from recordset to sheet
Do While Not rs1.EOF
.Range("A" & i).Value = Nz(rs1!StudentName, "")
.Range("B" & i).Value = Nz(rs1!DateofBirth, "")
.Range("C" & i).Value = Nz(rs1!Address, "")
.Range("D" & i).Value = Nz(rs1!PostalCode, "")
.Range("E" & i).Value = Nz(rs1!City, "")
.Range("F" & i).Value = Nz(rs1!Prov, "")
.Range("G" & i).Value = "YES"
.Range("H" & i).Value = Nz(rs1!Attempt, "")
.Range("I" & i).Value = Nz(rs1!ExamID, 0)
.Range("J" & i).Value = Nz(rs1!ExamDate, "")
.Range("K" & i).Value = Nz(rs1!ExamTime, "")
''Example: (Price - SalesPrice) / Price
''Example: =(C5 - D5) / C5
'.Range("F" & i).Formula = "=(C" & i & " - D" & i & ") / C" & i
i = i + 1
rs1.MoveNext
Loop
''Add conditional formatting - only 3 allowed
'With .Range("F5:F" & i).FormatConditions.Add(xlCellValue, xlBetween, 0, 0.0499)
'.Interior.Color = RGB(157, 255, 157)
'End With
'With .Range("F5:F" & i).FormatConditions.Add(xlCellValue, xlBetween, 0.05, 0.0999)
'.Interior.Color = RGB(255, 155, 55) 'orange
'End With
'With .Range("F5:F" & i).FormatConditions.Add(xlCellValue, xlGreaterEqual, 0.1)
'.Interior.Color = RGB(255, 53, 53) 'red
'End With
'i = i + 2
''Create footnote just for fun
'.Range("A" & i, "F" & i).Merge
'.Range("A" & i).Value = "* Caveat Emptor! Discounts can change at any time!"
'.Range("A" & i).Cells.Font.Size = 10
'.Range("A" & i).Characters(30, 10).Font.Bold = True
'.Range("A" & i).Characters(30, 10).Font.Italic = True
'.Range("A" & i).Characters(30, 10).Font.Color = vbRed
End With
SubExit:
On Error Resume Next
DoCmd.Hourglass False
xlApp.Visible = True
rs1.Close
Set rs1 = Nothing
ActiveWorkbook.SaveAs "P:\Training\Training Database\Exam booking form.xls", FileFormat:=56, AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution .xlLocalSessionChanges
Exit Sub
SubError:
MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit
End Sub