VBA Suche in Unterordnern und Outlook Anhang

Sub aaa()
Dim rng As Range
Const strPfad = "Z:\testordner"
Set rng = Range("A7")
Do While rng  ""
If Dir(strPfad & rng.Offset(, 6) & ".pdf", vbNormal) = "" Then
MsgBox "Die Datei gibt es nicht!", vbInformation, "Gebe bekannt..."
Else
rng.Offset(, 8).Select
ActiveSheet.OLEObjects.Add(Filename:=strPfad & rng.Offset(, 6) & ".pdf", Link:=False, _
DisplayAsIcon:=True, IconFileName:="T:\PFT\pft.ico", _
IconIndex:=0, IconLabel:="").Select
End If
Set rng = rng.Offset(1)
Loop
End Sub

Option Explicit
Public Sub TableToMail()
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.to =
.Subject =
.HTMLBody = RangeToHTML(ActiveSheet, ActiveSheet.Range("D2:I7"))
.Display 'nur Anzeigen
' .Send 'direkt senden
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub
Private Function RangeToHTML(objSheet As Worksheet, objRange As Range) As String
Dim strFilename As String
strFilename = Environ$("TEMP") & "/" & Format(Now, "dd-mm-yyyy_hh-mm-ss") & ".htm"
ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=objSheet.Name, _
Source:=objRange.Address, _
HtmlType:=xlHtmlStatic).Publish True
RangeToHTML = CreateObject("Scripting.FileSystemObject"). _
GetFile(strFilename).OpenAsTextStream(1, -2).ReadAll
Kill strFilename
End Function