merge PDF submacro gets stuck iin the while loop unless full path of varibale defined

Ok so below is a code that takes pdfs from one location based on a visible cell range and then put them in a created directory and then calls another module to merge the pdfs. In the second module there is a variable strPath that when the full folder path is defined it works fine. However trying to use a structure like "..\Submittal Packaged\BOM PDF\" it gets stuck in a while loop. I have debugged and watched it step through and find every pdf file in the folder but instead of not seeing the end it loops back to the beginning.

The below code is configured in the way I am having issues.

Option Explicit ' Force variable declaration
Public Const PDF_WILDCARD = "*.pdf"
Public Const JOIN_FILENAME = "MASTER BOM.pdf"
Public Sub CopyFile2()
    ChDrive "y:"
    ChDir ThisWorkbook.Path
    MkDir ("..\Submittal Packaged\BOM PDF\")
    Dim rng As Range
    Const strNewDir As String = "..\Submittal Packaged\BOM PDF\"
    
    For Each rng In Range("L9:L1042").SpecialCells(xlCellTypeVisible)
        If CBool(rng.Hyperlinks.Count) Then
            With rng.Hyperlinks(rng.Hyperlinks.Count)
                If CBool(InStr(.Address, Chr(92))) Then
                    If Dir(strNewDir & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))) = "" Then
                        FileCopy .Address, _
                        strNewDir & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))
                    Else
                        FileCopy .Address, _
                        strNewDir & rng.Row & "-" & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))
                    End If
                Else
                    If Dir(strNewDir & .Address) = "" Then
                        FileCopy .Address, _
                        strNewDir & .Address
                    Else
                        FileCopy .Address, _
                        strNewDir & rng.Row & "-" & .Address
                    End If
                End If
            End With
        End If
    Next rng
Call mergepdf
End Sub

Sub mergepdf()
    Dim AcroExchApp As Object, AcroExchPDDoc As Object, _
        AcroExchInsertPDDoc As Object
    Dim strFileName As String, strPath As String
    Dim iNumberOfPagesToInsert As Integer, _
        iLastPage As Integer
    Set AcroExchApp = CreateObject("AcroExch.App")
    Set AcroExchPDDoc = CreateObject("AcroExch.PDDoc")


' Set the directory / folder to use
    strPath = "..\Submittal Packaged\BOM PDF\"

' Get the first pdf file in the directory
    strFileName = Dir(strPath + PDF_WILDCARD, vbNormal)

' Open the first file in the directory
    AcroExchPDDoc.Open strPath + strFileName
    
' Get the name of the next file in the directory [if any]
    If strFileName <> "" Then
        strFileName = Dir
   
    ' Start the loop.
        Do While strFileName <> ""
    
    ' Get the total pages less one for the last page num [zerobased]
            iLastPage = AcroExchPDDoc.GetNumPages - 1
            Set AcroExchInsertPDDoc = CreateObject("AcroExch.PDDoc")
        
        ' Open the file to insert
            AcroExchInsertPDDoc.Open strPath + strFileName

        ' Get the number of pages to insert
            iNumberOfPagesToInsert = AcroExchInsertPDDoc.GetNumPages

        ' Insert the pages
        AcroExchPDDoc.InsertPages iLastPage, AcroExchInsertPDDoc, 0, iNumberOfPagesToInsert, True
    
        ' Close the document
            AcroExchInsertPDDoc.Close
    
       ' Get the name of the next file in the directory
            strFileName = Dir
             Loop
        
    ' Save the entire document as the JOIN_FILENAME using SaveFull
[0x0001 = &H1]
        AcroExchPDDoc.Save &H1, strPath + JOIN_FILENAME

End If

' Close the PDDoc
    AcroExchPDDoc.Close
        
' Close Acrobat Exchange
    AcroExchApp.Exit
End Sub