VBA: Create Slide for every Picture in a Folder

This short script runs in PowerPoint VBA. It looks in a given folder for any image and creates a new slide for that image. Once the image has been inserted it determines if the image is portrait or landscape and then resizes the picture, keeping the proportions, to fit the given slide layout as best it can.  

Option Explicit
Sub CreatePictureSlidesByFolder()
   'Define Variables
    Dim PictureFolder As String
    Dim CurrentSlide As Slide
    Dim CurrentFile As String
    Dim CurrentFileFullName As String
    Dim AllowedExtensions() As Variant
    
    'Set the Path to the folder of pictures
    PictureFolder = "\\data\staffdata\ctolley\My Pictures\Sample Pictures"
    
    'Check that the Picture folder path has a trailing \
    If Right(PictureFolder, 1) <> "\" Then PictureFolder = PictureFolder & "\"
    
    'Define the allowed picture extensions
    AllowedExtensions = Array("jpg", "png", "bmp")
    
    'Check that 1 slide exists in the presentation
    If ActivePresentation.Slides.Count = 0 Then
        ActivePresentation.Slides.Add 1, ppLayoutTitle
        ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = PictureFolder
    End If
    
    'Get the files in the folder
    CurrentFile = Dir(PictureFolder)
    
    While CurrentFile <> ""
    
    'Check that the file extension is allowed
    If IsStringInArray(GetFileExtension(CurrentFile), AllowedExtensions) Then
    
        'Make the full file name
        CurrentFileFullName = PictureFolder & CurrentFile
    
        'Add a new slide to the presentation
        Set CurrentSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutBlank)
        
        'Add the picture to the presentation
        With CurrentSlide.Shapes.AddPicture(CurrentFileFullName, msoFalse, msoTrue, 0, 0)
        
            'Check if the picture is landscape or portrait
            
            If .Width > .Height Then
                'Landscape
                .Width = ActivePresentation.PageSetup.SlideWidth
                .Left = 0
                .Top = (ActivePresentation.PageSetup.SlideHeight - .Height) / 2
            
            Else
                'Portrait
                .Height = ActivePresentation.PageSetup.SlideHeight
                .Left = (ActivePresentation.PageSetup.SlideWidth - .Width) / 2
                .Top = 0
            End If
            
        End With
        
    End If
            
    'Clear the current file
    CurrentFile = Dir
    
    Wend
End Sub

Public Function GetFileExtension(TheFilePath As String) As String
    'Separates the file extension from the file name and returns it.
    Dim FileParts() As String
    FileParts = Split(TheFilePath, ".")
    GetFileExtension = FileParts(UBound(FileParts))
End Function
Public Function IsStringInArray(TheString As String, TheArray() As Variant) As Boolean
    'Determines if the passed string is in the passed array.
    Dim ArrIdx As Integer
    For ArrIdx = LBound(TheArray) To UBound(TheArray)
        If TheString Like TheArray(ArrIdx) Then IsStringInArray = True
    Next ArrIdx
End Function