Basically here is what I want to do: I want a form (Selector) to have 4 check boxes and a Run command button. When the user clicks run another form (ReportsMenu) will appear giving various options. Importantly though, when the user clicks OK (in the ReportsMenu form) I want (depending on which check boxes are checked in the Selector form) to output the reports as pdf files. The code currently outputs the reports as snapshot or rich text format (depending on which radio button is checked in ReportsMenu) but they would prefer it if instead of this it just outputted straight to PDF when OK was clicked.
However currently the Selector form has 5 radio buttons (one is used to select all) so the user can only select all or one of the 4 options (which is why they want it to have check boxes instead so they can pick more than one but not necessarily all (which I have changed in the Selector form)). The problem (eventually got there i'm sorry!!) is with the ReportsMenu form. The original code for the ReportsMenu is very messy and, as i'm not very familiar with VBA (nor with the logic of the person who wrote the code), i'm not sure which parts to change (to print as PDF) and what to leave as it is. (I would just start the whole thing from scratch but there is some code linked to outlook that im not sure affects anything else at all or not)
Here is the code (it is very long I apologise):
Expand|Select|Wrap|Line Numbers
- Option Compare Database
- Function ExSnap1()
- On Error GoTo Macro1_Err
- Dim MyChoice As String
- Dim MyReport As String
- Dim MySchool As String
- If [Forms]![ReportsMenu]![ReportFrame] = 1 Then
- MyChoice = "Full Special Needs (Students and Invigilators) by Faculty"
- MyReport = "FullSpecialNeeds"
- Else
- If [Forms]![ReportsMenu]![ReportFrame] = 2 Then
- MyChoice = "FullTimetablebyFaculty"
- MyReport = "FullTimetable"
- Else
- If [Forms]![ReportsMenu]![ReportFrame] = 3 Then
- MyChoice = "StudentTimeTablesbyProgFaculty"
- MyReport = "StudentTimeTables"
- Else
- If [Forms]![ReportsMenu]![ReportFrame] = 4 Then
- If [Forms]![Selector]![chkall].Value = False Then
- Call TimetableBySchool 'individual school
- GoTo Ending
- Else 'all schools
- MyChoice = "Date Order Timetable with Locations"
- MyReport = "DateOrderTimeTables"
- End If
- Else
- If [Forms]![ReportsMenu]![ReportFrame] = 5 Then
- Call AllSnap 'all of the above
- Exit Function
- End If
- End If
- End If
- End If
- End If
- If [Forms]![Selector]![frmFileFormat] = 1 Then
- DoCmd.OutputTo acReport, MyChoice, "SnapshotFormat(*.snp)", "c:\" & MyReport & ".snp", False, ""
- Else
- DoCmd.OutputTo acReport, MyChoice, acFormatRTF, "c:\" & MyReport & ".rtf", False, ""
- End If
- If [Forms]![ReportsMenu]![ReportFrame] <> 4 Then
- MySchool = [Forms]![Selector]![School]
- Dim rst As Recordset
- Set rst = CurrentDb.OpenRecordset("Select Contact, Faculty_ID from SchoolContacts where Faculty_ID = '" & MySchool & "'")
- rst.MoveFirst
- Dim myName As String
- Dim mySchoolName As String
- myName = rst.Fields(0).Value
- End If
- Dim oOutlook As Outlook.Application
- Dim oMessage As Outlook.MailItem
- Dim sFileNames As String
- Dim oRecip As Outlook.Recipient
- Dim oAttach As Outlook.Attachment
- DoCmd.Echo True, "Emailing Report"
- Set oOutlook = CreateObject("Outlook.Application")
- Set oMessage = oOutlook.CreateItem(olMailItem)
- With oMessage
- .ReadReceiptRequested = True
- If [Forms]![ReportsMenu]![ReportFrame] <> 4 Then
- Set oRecip = .Recipients.Add(myName)
- oRecip.TYPE = olTo
- oRecip.Resolve
- Else
- MySchool = "All Schools"
- End If
- If [Forms]![Selector]![frmFileFormat] = 1 Then
- .Subject = Format(Now(), "yyyy-mm-dd") & " Exam Timetabling: Snapshot Report"
- .Body = "Find attached Snapshot Report: " & MyChoice & " for School Code: " & MySchool & vbCrLf & vbCrLf
- .Body = .Body & "If you do not have Snapshot viewer, download it from http://www.microsoft.com/downloads/details.aspx?amp;amp;displaylang=en&familyid=B73DF33F-6D74-423D-8274-8B7E6313EDFB&displaylang=en" & vbCrLf & vbCrLf
- Set oAttach = .Attachments.Add("c:\" & MyReport & ".snp")
- Else
- .Subject = Format(Now(), "yyyy-mm-dd") & " Exam Timetabling: Report"
- .Body = "Find attached Report: " & MyChoice & " for School Code: " & MySchool & vbCrLf & vbCrLf
- Set oAttach = .Attachments.Add("c:\" & MyReport & ".rtf")
- End If
- .Save
- '.send
- End With
- Set oOutlook = Nothing
- Macro1_Exit:
- Exit Function
- Macro1_Err:
- MsgBox Error$
- Resume Macro1_Exit
- Ending:
- End Function
- Function TimetableBySchool() 'date order timetable for the selected school
- On Error GoTo Macro1_Err
- Dim MyChoice As String
- Dim MyReport As String
- Dim MySchool As String
- MyChoice = "Date Order Timetable with Locations by School"
- MyReport = "DateOrderTimeTablesBySchool"
- If [Forms]![Selector]![frmFileFormat] = 1 Then
- DoCmd.OutputTo acReport, MyChoice, "SnapshotFormat(*.snp)", "c:\" & MyReport & ".snp", False, ""
- Else
- DoCmd.OutputTo acReport, MyChoice, acFormatRTF, "c:\" & MyReport & ".rtf", False, ""
- End If
- MySchool = [Forms]![Selector]![School]
- Dim rst As Recordset
- Set rst = CurrentDb.OpenRecordset("Select Contact, Faculty_ID from SchoolContacts where Faculty_ID = '" & MySchool & "'")
- rst.MoveFirst
- Dim myName As String
- Dim mySchoolName As String
- myName = rst.Fields(0).Value
- Dim oOutlook As Outlook.Application
- Dim oMessage As Outlook.MailItem
- Dim sFileNames As String
- Dim oRecip As Outlook.Recipient
- Dim oAttach As Outlook.Attachment
- DoCmd.Echo True, "Emailing Report"
- Set oOutlook = CreateObject("Outlook.Application")
- Set oMessage = oOutlook.CreateItem(olMailItem)
- With oMessage
- .ReadReceiptRequested = True
- If [Forms]![Selector]![frmFileFormat] = 1 Then
- .Subject = Format(Now(), "yyyy-mm-dd") & " Exam Timetabling: Snapshot Report"
- .Body = "Find attached Snapshot Report: " & MyChoice & " for School Code: " & MySchool & vbCrLf & vbCrLf
- .Body = .Body & "If you do not have Snapshot viewer, download it from http://www.microsoft.com/downloads/details.aspx?amp;amp;displaylang=en&familyid=B73DF33F-6D74-423D-8274-8B7E6313EDFB&displaylang=en" & vbCrLf & vbCrLf
- Set oAttach = .Attachments.Add("c:\" & MyReport & ".snp")
- Else
- .Subject = Format(Now(), "yyyy-mm-dd") & " Exam Timetabling: Report"
- .Body = "Find attached Report: " & MyChoice & " for School Code: " & MySchool & vbCrLf & vbCrLf
- Set oAttach = .Attachments.Add("c:\" & MyReport & ".rtf")
- End If
- .Save
- '.send
- End With
- Set oOutlook = Nothing
- Macro1_Exit:
- Exit Function
- Macro1_Err:
- MsgBox Error$
- Resume Macro1_Exit
- End Function
- Function AllSnap() 'all of the above option
- On Error GoTo Macro1_Err
- Dim MyChoice As String
- Dim MyReport As String
- Dim MySchool As String
- MyChoice = "Full Special Needs (Students and Invigilators) by Faculty"
- MyReport = "FullSpecialNeeds"
- MyChoice1 = "FullTimetablebyFaculty"
- MyReport1 = "FullTimetableby"
- MyChoice2 = "StudentTimeTablesbyProgFaculty"
- MyReport2 = "StudentTimeTables"
- If [Forms]![Selector]![frmFileFormat] = 1 Then
- DoCmd.OutputTo acReport, MyChoice, "SnapshotFormat(*.snp)", "c:\" & MyReport & ".snp", False, ""
- DoCmd.OutputTo acReport, MyChoice1, "SnapshotFormat(*.snp)", "c:\" & MyReport1 & ".snp", False, ""
- DoCmd.OutputTo acReport, MyChoice2, "SnapshotFormat(*.snp)", "c:\" & MyReport2 & ".snp", False, ""
- Else
- DoCmd.OutputTo acReport, MyChoice, acFormatRTF, "c:\" & MyReport & ".rtf", False, ""
- DoCmd.OutputTo acReport, MyChoice1, acFormatRTF, "c:\" & MyReport1 & ".rtf", False, ""
- DoCmd.OutputTo acReport, MyChoice2, acFormatRTF, "c:\" & MyReport2 & ".rtf", False, ""
- End If
- MySchool = [Forms]![Selector]![School]
- Dim rst As Recordset
- Set rst = CurrentDb.OpenRecordset("Select Contact, Faculty_ID from SchoolContacts where Faculty_ID = '" & MySchool & "'")
- rst.MoveFirst
- Dim myName As String
- Dim mySchoolName As String
- myName = rst.Fields(0).Value
- Dim oOutlook As Outlook.Application
- Dim oMessage As Outlook.MailItem
- Dim sFileNames As String
- Dim oRecip As Outlook.Recipient
- Dim oAttach As Outlook.Attachment
- Dim oAttach1 As Outlook.Attachment
- Dim oAttach2 As Outlook.Attachment
- DoCmd.Echo True, "Emailing Report"
- Set oOutlook = CreateObject("Outlook.Application")
- Set oMessage = oOutlook.CreateItem(olMailItem)
- With oMessage
- .ReadReceiptRequested = True
- If [Forms]![ReportsMenu]![ReportFrame] <> 4 Then
- Set oRecip = .Recipients.Add(myName)
- Else
- Set oRecip = .Recipients.Add("rgbf1")
- End If
- oRecip.TYPE = olTo
- oRecip.Resolve
- If [Forms]![Selector]![frmFileFormat] = 1 Then
- .Subject = Format(Now(), "yyyy-mm-dd") & " Exam Timetabling: Snapshot Report"
- .Body = "Find attached Snapshot Reports: " & MyChoice & ", " & MyChoice1 & " and " & MyChoice2 & " for School Code: " & MySchool & vbCrLf & vbCrLf
- .Body = .Body & "If you do not have Snapshot viewer, download it from http://www.microsoft.com/downloads/details.aspx?amp;amp;displaylang=en&familyid=B73DF33F-6D74-423D-8274-8B7E6313EDFB&displaylang=en" & vbCrLf & vbCrLf
- Set oAttach = .Attachments.Add("c:\" & MyReport & ".snp")
- Set oAttach1 = .Attachments.Add("c:\" & MyReport1 & ".snp")
- Set oAttach2 = .Attachments.Add("c:\" & MyReport2 & ".snp")
- Else
- .Subject = Format(Now(), "yyyy-mm-dd") & " Exam Timetabling: Report"
- .Body = "Find attached Snapshot Reports: " & MyChoice & ", " & MyChoice1 & " and " & MyChoice2 & " for School Code: " & MySchool & vbCrLf & vbCrLf
- Set oAttach = .Attachments.Add("c:\" & MyReport & ".rtf")
- Set oAttach1 = .Attachments.Add("c:\" & MyReport1 & ".rtf")
- Set oAttach2 = .Attachments.Add("c:\" & MyReport2 & ".rtf")
- End If
- .Save
- '.send
- End With
- Set oOutlook = Nothing
- Macro1_Exit:
- Exit Function
- Macro1_Err:
- MsgBox Error$
- Resume Macro1_Exit
- End Function
If you need me to clarify anything else let me know
Thankyou I really appreciate it!