Reducing Same Code in If and ElseIf Statement (1 Viewer)

[dgreen]

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/ '###########

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

End Sub[/code]

 

[theDBguy]

Hi. I didn't look at your code, but was just wondering if you could create a separate Sub for the routine you're duplicating?

 

[plog]

You posted a wall of text and I found at least 10 statements that start with "If", so I didn't dig into it either. However with that said, code can work like algebra:

(8x^2 + 16x) - 2

You can reduce that like so:

x*(8x + 16) - 2
8x*(x + 2) -2

Suppose what's inside the parenthesis are if/else blocks. If you are doing the same operation in both the if and the else; you can move that operation outside the if/else and just do it once outside of the if/else. Suppose you are sending an email and the if/else controls all its differences :

if (Something=True)
   SendEmail("This is the If Subject Line", "This is the If Body", "ifto@ifto.com", "iffrom@iffrom.com"
Else
   SendEmail("This is the Else Subject Line, "This is the Else Body", "elseto@elseto.com", "elsefrom@elsefrom.com"
End

The below would be the way to do that calling SendEmail just once:

if (Something=True)
  strSubject="This is the If Subject Line"
  strBody="This is the If Body"
  strTo="ifto@ifto.com"
  strFrom="iffrom@iffrom.com"
Else
   strSubject="This is the Else Subject Line"
  strBody="This is the Else Body"
  strTo="elseto@elseto.com"
  strFrom="elsefrom@elsefrom.com"
End

SendEmail(strSubject, strBody, strTo, strFrom)

While that example uses more lines than the initial code it demonstrates how you use variables in the manner I described. Often in real code it does reduce code lines.

 

[vba_php]

How do I come out of an If / ElseIf check and then go into another grouping, all within the same action?

I think an explanation of those words of yours is probably necessary. not sure anyone follows that.

you can't come OUT of an if/else check. the procedure comes out on its own simply be executing procedurally. code doesn't run faster than inside IF/ELSE statements. that's the absolute basic of programming logic. the smallest possible construct, relatively speaking. if you're talking about SKIPPING from one area of code to another, this statement is available in access's language, which is basic:

goto LABEL_HERE

and then the line of code you want to go to would have a label with it (as an indicator of the point to SKIP TO), followed by a colon, like this:

LABEL_HERE:
'code here

 

[Pat Hartman]

There are several ways to reuse code. For this, I would probably use a GoSub. I'll post an outline of the structure.

Private Sub Command23_Click()

    If something Then
        GoSub CommonCode
    Else
        If another thing Then
            If a thirdthing Then
                GoSub CommonCode
            End If
        End If
    End If

ExitSub:
    Exit Sub

CommonCode:
    lines of common code

    Return
End Sub

1. ALWAYS change the control's name to something MEANINGFUL BEFORE you start writing code. Changing it after, requires more effort. Do it anyway. It is really poor practice to have code with names like Command23. Even YOU will be scratching your head next month if you have to look at the code.
2. The ExitSub procedure is to make sure that your mainline code doesn't fall into the commoncode sub.
3. The Return is to make sure that the commoncode doesn't fall out of the click event.