How to import bulk pictures in Power Point from folder using Open Dialogue Box to Select Entire Folder and Make New Slide for each Picture

Question

I am trying to automate Powerpoint presentation. I found a code on the internet. This code is working well, but it works with the static path in the code. I want to implement it using OpenFolder Dialogue Box. The idea is as, When I click the button import picture, the file dialogue box should be open and I select the folder. The pictures within the folder automatically and the size of the picture should automatically fit the slide. When this process complete, the slide show automatically starts to display the picture using fade animation. The code is as under.

Sub main()
Dim i As Integer
Dim arrFilesInFolder As Variant
arrFilesInFolder = GetAllFilesInDirectory("C:\Users\Admin\OneDrive\Pictures\Screenshots")

For i = LBound(arrFilesInFolder) To UBound(arrFilesInFolder)
    Call AddSlideAndImage(arrFilesInFolder(i))
Next
End Sub
Private Function GetAllFilesInDirectory(ByVal strDirectory As String) As Variant
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim arrOutput() As Variant
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(strDirectory)
ReDim arrOutput(0)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
 
    'print file path
    arrOutput(i - 1) = objFile.Path
    ReDim Preserve arrOutput(UBound(arrOutput) + 1)
    i = i + 1
Next objFile
   ReDim Preserve arrOutput(UBound(arrOutput) - 1)
GetAllFilesInDirectory = arrOutput
End Function

Private Function AddSlideAndImage(ByVal strFile As String)
Dim objPresentaion As presentation
Dim objSlide As slide

Set objPresentaion = ActivePresentation

Set objSlide = objPresentaion.Slides.Add(1, PpSlideLayout.ppLayoutChart)
Call objSlide.Shapes.AddPicture(strFile, msoCTrue, msoCTrue, 100, 100, 650, 450)
End Function

Please someone guide, where I am doing wrong. Thanks

Answer 1

Looks like you need to replace the hard-coded file path with code that prompts the user for one. Seems Application.FileDialog should get you there:

Dim path As String
With Application.FileDialog(Type:=msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show Then
        path = .SelectedItems(1)
    Else
        'user cancelled, bail out:
        Exit Sub
    End If
End With

Dim arrFilesInFolder As Variant
arrFilesInFolder = GetAllFilesInDirectory(path)
'...rest of the code...