The below code works but I'm having to maintain two instances of building the email (one for the initial If and another if we go down the ElseIf statement).
How do I come out of an If / ElseIf check and then go into another grouping, all within the same action?
Here's a portion of the code (due to size constraints), but the section that I'm trying to reduce the code on is marked twice w/ '###########
End Sub[/code]
How do I come out of an If / ElseIf check and then go into another grouping, all within the same action?
Here's a portion of the code (due to size constraints), but the section that I'm trying to reduce the code on is marked twice w/ '###########
Code:
Private Sub Command23_Click()
'Code removed.
ClickResult = Dialog.RichBox("Would you like to post these meeting notes to the SharePoint Folder?", vbOKCancel + vbInformation, "Export / Save Report", , , 0, False, False, False)
If ClickResult = vbOK Then
'Does a folder exist on SharePoint? If no, then.
If Len(Dir([SharePointPath] & [CaptureEvent], vbDirectory)) = 0 Then
'Make the directory path and create the folder
MkDir [SharePointPath] & [CaptureEvent]
'Insert the new folder path into t_Event_Website_SharePoint list without asking the user.
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO [t_Event_Website_SharePoint] ([Event_ID],[Description],[Website_SharePoint_Site]) Values ('" & Me.Event_ID & "', '" & [Title] & "', '" & [SharePointPath] & [CaptureEvent] & "')"
DoCmd.SetWarnings True
'Put the file in the SharePoint folder
DoCmd.OutputTo acOutputReport, Report, acFormatPDF, OutPutPath
'Insert the new file's path into t_Event_Website_SharePoint without asking the user.
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO [t_Event_Website_SharePoint] ([Event_ID],[Description],[Website_SharePoint_Site]) Values ('" & Me.Event_ID & "', '" & [TitleDoc] & "', '" & [OutPutPath] & "')"
DoCmd.SetWarnings True
'################
'Close and reopen the report so the new links are populated.
DoCmd.Close acReport, Report
'Open the updated report that now shows the new links to include the current file
'This also changes the file name to match the filter
DoCmd.OpenReport Report, acViewPreview, , WhereCriteria, acHidden
Reports(Report).caption = TitleDoc
ClickResult = Dialog.RichBox("Would you like to email these meeting notes?", vbOKCancel + vbInformation, "Email Report", , , 0, False, False, False)
If ClickResult = vbOK Then
'***creates an instance of Outlook
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
.Display
End With
Signature = OMail.HTMLBody
'***creates and sends email
ClickResult = Dialog.RichBox("Use the attendee's list (YES) or select individual emails (NO)", vbYesNo + vbInformation, "Outlook TO Selection", , , 0, False, False, False)
With OMail
If ClickResult = vbYes Then
Set rs = CurrentDb.OpenRecordset("select * from q_Event_Contact_Email where Event_ID = " & Event_ID)
If rs.RecordCount > 0 Then
rs.MoveFirst
Do Until rs.EOF
'If the customer doesn't have an email move to the next record.
If IsNull(rs!Email_Address) Then
rs.MoveNext
Else
PEmail = PEmail & rs!Email_Address & ";"
.To = PEmail
rs.MoveNext
End If
Loop
Else
MsgBox "No customer on list has an email on file"
End If
ElseIf ClickResult = vbNo Then
.To = ""
End If
.CC = ""
.Subject = Me.Event & " (" & Format(Me.Start_Date, "yyyy.mm.dd") & ")"
.HTMLBody = strBody & Signature
.Attachments.Add OutPutPath
ClickResult = Dialog.RichBox("Do you have additional attachments to add?", vbYesNo + vbInformation, "Attachments", , , 0, False, False, False)
If ClickResult = vbYes Then
Application.FollowHyperlink [SharePointPath] & [CaptureEvent], , True
End If
ClickResult = Dialog.RichBox("Prior to emailing, do you want to .zip the attachments to reduce the email size?", vbYesNo + vbInformation, "Zip Attachments", , , 0, False, False, False)
If ClickResult = vbYes Then
Call ZipAttachments
End If
'.Send
ClickResult = Dialog.RichBox("Do you want to save the email to SharePoint?", vbYesNo + vbInformation, "Save Email", , , 0, False, False, False)
If ClickResult = vbYes Then
OMail.SaveAs TargetFile
End If
End With
Set OMail = Nothing
Set OApp = Nothing
ElseIf ClickResult = vbCancel Then
DoCmd.Close acReport, Report
End If
DoCmd.Close acReport, Report
'If a folder exists on SharePoint then...
ElseIf Len(Dir([SharePointPath] & [CaptureEvent], vbDirectory)) > 0 Then
DoCmd.OutputTo acOutputReport, Report, acFormatPDF, OutPutPath
'if the exact file name is not in the directory then insert it into the website table, otherwise just open the report.
If Len(Dir([OutPutPath], vbDirectory)) = 0 Then
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO [t_Event_Website_SharePoint] ([Event_ID],[Description],[Website_SharePoint_Site]) Values ('" & Me.Event_ID & "', '" & [TitleDoc] & "', '" & [OutPutPath] & "')"
DoCmd.SetWarnings True
End If
'################
'Close and reopen the report so the new links are populated.
DoCmd.Close acReport, Report
'Open the updated report that now shows the new links to include the current file
'This also changes the file name to match the filter
DoCmd.OpenReport Report, acViewPreview, , WhereCriteria, acHidden
Reports(Report).caption = TitleDoc
ClickResult = Dialog.RichBox("Would you like to email these meeting notes?", vbOKCancel + vbInformation, "Email Report", , , 0, False, False, False)
If ClickResult = vbOK Then
'***creates an instance of Outlook
Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
With OMail
.Display
End With
Signature = OMail.HTMLBody
'***creates and sends email
ClickResult = Dialog.RichBox("Use the attendee's list (YES) or select individual emails (NO)", vbYesNo + vbInformation, "Outlook TO Selection", , , 0, False, False, False)
With OMail
'Code removed to allow me to post
End If
'Other answer to save to SharePoint
ElseIf ClickResult = vbCancel Then
Exit Sub
End If
End Sub