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