OK, the reference to:
strFiles2 = Dir(strFldr1 & "*.emf", vbNormal)
should have been to:
strFiles2 = Dir(strFldr2 & "*.emf", vbNormal)
which I've fixed. Regardless, the code needed further tweaking. Try something based on:
Sub Demo()
Application.ScreenUpdating = False
Dim strFldr1 As String, strFiles1 As String, strTmp As String, wdDoc As Document
Dim strFldr2 As String, strFiles2 As String, strFile As String, r As Long
strFldr1 = "C:\Users\" & Environ("Username") & "\Pictures\Folder1\"
strFldr2 = "C:\Users\" & Environ("Username") & "\Pictures\Folder2\"
strFiles2 = Dir(strFldr2 & "*.emf", vbNormal): strTmp = "|"
While strFiles2 <> ""
strTmp = strTmp & "|" & Split(strFiles2, ".emf")(0)
strFiles2 = Dir()
Wend
strFiles1 = Dir(strFldr1 & "*.tif", vbNormal)
Set wdDoc = Documents.Add(Template:="C:\Users\" & Environ("Username") & "\Templates\Table.dotm")
With wdDoc.Tables(1)
While strFiles1 <> ""
.Rows.Add
r = .Rows.Count: strFile = Split(strFiles1, ".tif")(0)
.Range.InlineShapes.AddPicture FileName:=strFldr1 & strFiles1, _
LinkToFile:=False, Range:=.Cell(r, 1).Range
If InStr(strTmp, "|" & strFile & "|") > 0 Then
.Range.InlineShapes.AddPicture FileName:=strFldr2 & strFile & ".emf", _
LinkToFile:=False, Range:=.Cell(r, 2).Range
.Cell(r, 2).Range.Characters.Last.InsertBefore vbCr & strFile
End If
strFiles1 = Dir()
Wend
.Rows(3).Delete
End With
Application.ScreenUpdating = True
End Sub