Debugging MS Word Macro for importing JPGs that is returning duplicate images - vba

Question

I'm looking through the following macro I inherited and trying to figure out why it's importing duplicate images when it pulls unique photos from the same folder. Any help would be much appreciated, I don't have a lot of experience with VBA.
The purpose of the macro is to pull all image files in the same folder as the word document and embed them in the word document itself. Right now it's taking the first image in the folder and embedding it multiple times. I think it's an issue with the loop logic but I'm pretty new to VBA and having trouble fixing it.
Option Explicit
Dim msPath As String
Dim msPictures() As String
Dim mlPicturesCnt As Long
Public Sub ImportJPGFiles()
On Error GoTo Err_ImportJPGFiles
Dim lngCount As Long
Dim lngPicture As Long
Dim strMsg As String
Dim sngBEGTime As Single
Dim sngENDTime As Single
'Assume JPG files are in same directory as
'as the Word document containing this macro.
msPath = Application.ActiveDocument.Path & "\"
lngCount = LoadPicturesArray
'Let user browse to correct folder if pictures aren't in the same
'folder as Word document
While lngCount < 0
strMsg = "Unable to find any JPG files in the following" & vbCrLf & _
"directory:" & vbCrLf & vbCrLf & _
msPath & vbCrLf & vbCrLf & _
"Press the 'OK' button if you want to browse to" & vbCrLf & _
"the directory containing your JPG files. Press" & vbCrLf & _
"the 'Cancel' button to end this macro."
If (MsgBox(strMsg, vbOKCancel + vbInformation, "Technical Difficulties")) = vbOK Then
With Application
.WindowState = wdWindowStateMinimize
msPath = BrowseForDirectory
.WindowState = wdWindowStateMaximize
End With
If LenB(msPath) <> 0 Then
If Right$(msPath, 1) <> "\" Then
msPath = msPath & "\"
End If
lngCount = LoadPicturesArray
Else
Exit Sub
End If
Else
Exit Sub
End If
Wend
Application.ScreenUpdating = False
sngBEGTime = Timer
For lngPicture = 0 To lngCount
Application.StatusBar = "Importing picture " & _
CStr(lngPicture + 1) & " of " & _
CStr(lngCount + 1) & " pictures..."
With Selection
.EndKey Unit:=wdStory
.MoveUp Unit:=wdLine, Count:=21, Extend:=wdExtend
.Copy
.EndKey Unit:=wdStory
.InsertBreak Type:=wdPageBreak
.Paste
.MoveUp Unit:=wdLine, Count:=24
.InlineShapes.AddPicture FileName:=msPath & msPictures(lngPicture), _
LinkToFile:=False, _
SaveWithDocument:=True
End With
Next lngPicture
sngENDTime = Timer
strMsg = "Import Statistics: " & vbCrLf & vbCrLf & _
"Pictures Imported: " & CStr(lngCount + 1) & vbCrLf & _
"Total Seconds: " & Format((sngENDTime - sngBEGTime), "###0.0") & vbCrLf & _
"Seconds/Picture: " & Format((sngENDTime - sngBEGTime) / (lngCount + 1), "###0.00")
MsgBox strMsg, , "Finished"
Exit_ImportJPGFiles:
With Application
.StatusBar = "Ready"
.ScreenUpdating = True
End With
Exit Sub
Err_ImportJPGFiles:
MsgBox Err.Number & " - " & Err.Description, , "ImportJPGFiles"
Resume Exit_ImportJPGFiles
End Sub
Public Function LoadPicturesArray() As Long
On Error GoTo Err_LoadPicturesArray
Dim strName As String
strName = Dir(msPath)
mlPicturesCnt = 0
ReDim msPictures(0)
Do While strName <> ""
If strName <> "." And strName <> ".." _
And strName <> "pagefile.sys" Then
If UCase(Right$(strName, 3)) = "JPG" Then
msPictures(mlPicturesCnt) = strName
mlPicturesCnt = mlPicturesCnt + 1
ReDim Preserve msPictures(mlPicturesCnt)
'Debug.Print strName
End If
End If
strName = Dir
Loop
Call QSort(msPictures, 0, mlPicturesCnt - 1)
' Dim i As Integer
' Debug.Print "----AFTER SORT----"
' For i = 0 To mlPicturesCnt - 1
' Debug.Print msPictures(i)
' Next i
LoadPicturesArray = mlPicturesCnt - 1
Exit_LoadPicturesArray:
Exit Function
Err_LoadPicturesArray:
MsgBox Err.Number & " - " & Err.Description, , "LoadPicturesArray"
Resume Exit_LoadPicturesArray
End Function
Public Sub QSort(ListArray() As String, lngBEGOfArray As Long, lngENDOfArray As Long)
Dim i As Long
Dim j As Long
Dim strPivot As String
Dim strTEMP As String
i = lngBEGOfArray
j = lngENDOfArray
strPivot = ListArray((lngBEGOfArray + lngENDOfArray) / 2)
While (i <= j)
While (ListArray(i) < strPivot And i < lngENDOfArray)
i = i + 1
Wend
While (strPivot < ListArray(j) And j > lngBEGOfArray)
j = j - 1
Wend
If (i <= j) Then
strTEMP = ListArray(i)
ListArray(i) = ListArray(j)
ListArray(j) = strTEMP
i = i + 1
j = j - 1
End If
Wend
If (lngBEGOfArray < j) Then QSort ListArray(), lngBEGOfArray, j
If (i < lngENDOfArray) Then QSort ListArray(), i, lngENDOfArray
End Sub