Sub ProcessFolderImages()
    Dim FolderName As String
    FolderName = SelectFolder
    
    On Error GoTo ErrProcessFolderImages

    If FolderName <> "" Then ' ---- An empty string indicates the cancel button was clicked
        Dim FileArray() As Variant
        Dim FileCount As Integer
        Dim FileName As String

        On Error GoTo ErrProcessFolderImages

        FileCount = 0
        FileName = Dir(FolderName)
        If FileName = "" Then GoTo NoFilesFound
        
        '   Loop until no more matching files are found
        Do While FileName <> ""
            If Right(FileName, 4) = ".jpg" Then
                FileCount = FileCount + 1
                FileName = FolderName & FileName
                Select Case FileCount
                    Case 1
                        CropAndMove FileName, 1.094, 10.5
                    Case 2
                        CropAndMove FileName, 2.494, 10.5 ' ---- Change these values depending on the slot they need to go into
                    Case 3
                        CropAndMove FileName, 3.894, 10.5 ' ---- Change these values depending on the slot they need to go into
                    Case 4
                        CropAndMove FileName, 5.294, 10.5 ' ---- Change these values depending on the slot they need to go into
                    Case 5
                        CropAndMove FileName, 6.694, 10.5 ' ---- Change these values depending on the slot they need to go into
                    Case 6
                        CropAndMove FileName, 8.094, 10.5 ' ---- Change these values depending on the slot they need to go into
                    Case 7
                        CropAndMove FileName, 9.494, 10.5 ' ---- Change these values depending on the slot they need to go into
                    Case 8
                        CropAndMove FileName, 10.894, 10.5 ' ---- Change these values depending on the slot they need to go into
                    Case 9
                        CropAndMove FileName, 12.294, 10.5 ' ---- Change these values depending on the slot they need to go into
                    Case 10
                        CropAndMove FileName, 13.694, 10.5 ' ---- Change these values depending on the slot they need to go into
                    Case Else
                        Exit Do ' ---- Stop looping at the max of 10 files with valid file extensions found
                End Select
                    
                ReDim Preserve FileArray(1 To FileCount)
                FileArray(FileCount) = FileName
            End If
            
            FileName = Dir
        Loop
            
    End If

    Windows.FindWindow("C:\Users\Don\Documents\Laser Etching\Human Tags\Camera Project\Location Template 8 Pack.cdr").ActiveView.SetViewPoint 9.01, 5.986665, 100

    MsgBox "Processing complete!", vbOK, "Done!"
ExitProcessFolderImages:
    Exit Sub
ErrProcessFolderImages:
    MsgBox "The following error was encountered: " & Err.Number & " " & Err.Description, vbOK, "No JPG Files Found"
    Resume ExitProcessFolderImages
NoFilesFound:
    MsgBox "No valid JPG files were found for the selected directory.  Please verify files and try again.", vbOK, "No JPG Files Found"
    Resume ExitProcessFolderImages

End Sub

Sub CropAndMove(ByVal strFile As String, ByVal decPos1 As Double, ByVal decPos2 As Double)
    Dim impopt As StructImportOptions
    Set impopt = CreateStructImportOptions
    impopt.Mode = cdrImportFull
    Dim impflt As ImportFilter
    Set impflt = ActiveLayer.ImportEx(strFile, cdrJPEG, impopt)
    impflt.Finish
    Dim s1 As Shape
    Set s1 = ActiveShape
    s1.Move 8.39665, -7.938008
    Dim grp1 As ShapeRange
    Set grp1 = s1.UngroupEx
    grp1.Rotate 270#
    grp1.AlignToPageCenter cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, cdrTextAlignBoundingBox
    Windows.FindWindow("C:\Users\Don\Documents\Laser Etching\Human Tags\Camera Project\Location Template 8 Pack.cdr").ActiveView.ToFitAllObjects
    Dim crop1 As ShapeRange
    Set crop1 = grp1.CustomCommand("Crop", "CropRectArea", -0.3345, 1.3245, 17.9185, 21.6455)
    ActiveDocument.ReferencePoint = cdrCenter
    crop1.SetSize 1.13, 1.258024
    crop1.SetSize 1.129984, 1.258
    crop1.ApplyEffectInvert
    crop1.SetPosition decPos1, decPos2
End Sub

Function SelectFolder(Optional Title As String, Optional TopFolder _
                         As String) As String
    Dim objShell As New Shell32.Shell
    Dim objFolder As Shell32.Folder

    Set objFolder = objShell.BrowseForFolder _
                            (0, Title, 1, TopFolder)
    If Not objFolder Is Nothing Then
        SelectFolder = objFolder.Items.Item.Path & "\"
    End If
End Function