The basic problem with your code is that the Dir inside the loop wipes out the data for the outer Dir. Try:
Code:
Sub Case_Image()
Dim strFldr As String, strDocs As String, strImgs As String, strPath As String, StrImg As String
Dim wdDoc As Document, Rng As Range, i As Long
strPath = "C:\Cases\" '>>>>> change folder path if cases stored in different folder
strFldr = Dir(strPath & "*.doc", vbNormal) '>>>>> check if doc or docx and change accordingly
'Build document & image lists
While strFldr <> ""
strImgs = strImgs & vbCr & strPath & "\images\" & Left(strFldr, InStrRev(strFldr, ".")) & "jpg"
strDocs = strDocs & vbCr & strPath & strFldr
strFldr = Dir()
Wend
'Loop through the lists to match documents with images
For i = 1 To UBound(Split(strDocs, vbCr))
'If the document and its image are both found, add the image to the document
If (Dir(Split(strImgs, vbCr)(i), vbNormal) <> "") And (Dir(Split(strDocs, vbCr)(i), vbNormal) <> "") Then
Set wdDoc = Documents.Open(Split(strDocs, vbCr)(i), AddToRecentFiles:=False)
With wdDoc
.Range.Characters.First.InsertBreak wdPageBreak
Set Rng = .Range.Characters.First
Rng.Collapse wdCollapseStart
.InlineShapes.AddPicture FileName:=Split(strImgs, vbCr)(i), _
LinkToFile:=False, SaveWithDocument:=True, Range:=Rng
.Close True
End With
'If the image is missing, report it
ElseIf (Dir(Split(strImgs, vbCr)(i), vbNormal) <> "") Then
MsgBox Split(strImgs, vbCr)(i) & vbCr & "Not found", vbInformation
End If
Next
Set Rng = Nothing: Set wdDoc = Nothing
MsgBox "", vbInformation, "Folder consolidated"
End Sub