Hi I'm relatively new to VBA and could really do with some help please!! This is going to sound really long winded i'm sorry but I hope it will paint a picture of what i'm trying to do.
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):
As you can see the code is very messy and hard to follow for a simpleton like me. If you could help me to adjust the code accordingly that would be great!
If you need me to clarify anything else let me know
Thankyou I really appreciate it!
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):
Code:
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!
Comment