Sub GetHyperlinksForFilesWithCodeNameFromB()
Dim oWB As Workbook
Dim rCell As Range, rSearchRange As Range
Dim sFolder$, sCode$, sFileName$, sSheetName$, sVal$
Dim oFso As Object
Dim oFolder As Object

Set oWB = ActiveWorkbook
sSheetName = "Лист1" 'Я пишу лист1, вы своё название листа
Set rSearchRange = oWB.Sheets(sSheetName).Range("B1:B" & Sheets(sSheetName).Cells(Rows.Count, 2).End(xlUp).Row)

For Each rCell In rSearchRange
    If Not IsEmpty(rCell.Value) Then
        sVal = rCell.Value
        sCode = Right(sVal, Len(sVal) - InStrRev(sVal, "-"))
        sVal = Left(sVal, Len(sVal) - Len(sCode) - 1)
        sCode = Right(sVal, Len(sVal) - InStrRev(sVal, "-")) & "-" & sCode
        For Цикл = 1 To 2
            Select Case Цикл
                'сюда пишем  для входящих
                Case 1:
                    sFolder = "D:\Входящие" 'Например "D:\Входящие\"
                    sCol = "L" 'Столбец, куда будем вставлять
                'сюда пишем  для исходящих
                Case 2:
                    sFolder = "D:\Исходящие" 'Например "D:\Исходящие\"
                    sCol = "K" 'Столбец, куда будем вставлять
            End Select
            'А сюда код из основной процедуры
            
            Set oFso = CreateObject("Scripting.FileSystemObject")
            Set oFolder = oFso.GetFolder(sFolder)
            Call RecursiveSubFolders(oFolder, sCode, oWB, sCol, sSheetName, rCell)
        Next Цикл
    Else
        Exit Sub
    End If
Next rCell
Set oFso = Nothing
End Sub

Sub RecursiveFiles(ByRef oFolder As Object, ByVal sCode As String, ByRef oWB As Workbook, _
                            ByVal sCol As String, ByVal sSheetName As String, ByRef rCell As Range)
Dim oFile As Object
Dim sFilePath As String
    For Each oFile In oFolder.Files
        sFil = oFile.Name
        If InStr(oFile.Name, sCode) >= 1 Then
            sFilePath = oFile.Path
            oWB.Sheets(sSheetName).Hyperlinks.Add Anchor:=oWB.Sheets(sSheetName).Range(sCol & rCell.Row), _
                                                    Address:=sFilePath, TextToDisplay:=Format(Date, "dd.mm.yyyy")
        End If
    Next oFile
End Sub

Sub RecursiveSubFolders(ByRef oFolder As Object, ByVal sCode As String, ByRef oWB As Workbook, _
                            ByVal sCol As String, ByVal sSheetName As String, ByRef rCell As Range)
Dim oSubFolder As Object
    If oFolder.Subfolders.Count >= 1 Then
        For Each oSubFolder In oFolder.Subfolders
            Call RecursiveFiles(oFolder, sCode, oWB, sCol, sSheetName, rCell)
            If oFolder.Subfolders.Count >= 1 Then
                Call RecursiveSubFolders(oSubFolder, sCode, oWB, sCol, sSheetName, rCell)
            End If
        Next oSubFolder
    Else
        Call RecursiveFiles(oFolder, sCode, oWB, sCol, sSheetName, rCell)
    End If
End Sub

Sub GEGJ()
Dim oWB As Workbook
Dim rCell As Range, rSearchRange As Range
Dim sFolder$, sCode$, sFileName$
Dim oFso As Object
Dim oFolder As Object

Set oWB = ActiveWorkbook
sFolder = "D:\" 'я пишу Д, вы свою
'Я пишу лист1, вы своё название листа
Set rSearchRange = oWB.Sheets("Лист1").Range("B1:B" & Sheets("Лист1").Cells(Rows.Count, 2).End(xlUp).Row)

For Each rCell In rSearchRange
    If Not IsEmpty(rCell.Value) Then
        sCode = "-" & Right(rCell.Value, Len(rCell.Value) - InStrRev(rCell.Value, "-"))
        Set oFso = CreateObject("Scripting.FileSystemObject")
        Set oFolder = oFso.GetFolder(sFolder)
        Call RecursiveSubFolders(oFolder, sCode, oWB)
    Else
        Exit Sub
    End If
Next rCell
Set oFso = Nothing
End Sub
Sub RecursiveFiles(ByRef oFolder As Object, ByVal sCode As String, ByRef oWB As Workbook)
Dim oFile As Object
Dim sFilePath As String
    For Each oFile In oFolder.Files
        sFil = oFile.Name
        If InStr(oFile.Name, sCode) >= 1 Then
            sFilePath = oFile.Path
            oWB.Sheets("Лист1").Range("L" & rCell.Row) = "=HYPERLINK(" & sFilePath & ")"
        End If
    Next oFile
End Sub
Sub RecursiveSubFolders(ByRef oFolder As Object, ByVal sCode As String, ByRef oWB As Workbook)
Dim oSubFolder As Object
    If oFolder.Subfolders.Count >= 1 Then
        For Each oSubFolder In oFolder.Subfolders
            Call RecursiveFiles(oFolder, sCode, oWB)
            If oFolder.Subfolders.Count >= 1 Then
                Call RecursiveSubFolders(oSubFolder, sCode, oWB)
            End If
        Next oSubFolder
    Else
        Call RecursiveFiles(oFolder, sCode, oWB)
    End If
End Sub

For Цикл = 1 to 2
Select Case Цикл
'сюда пишем  для входящих
Case 1:
sFolder = "ваш путь"
'сюда пишем  для исходящих
Case 2:
sFolder = "ваш путь"
End Select
'А сюда код из основной процедуры
Next Цикл