Function GetAllFileNamesUsingFSO(ByVal FolderPath As String, ByVal Mask As String, ByRef FSO, _                                 
ByRef FileNamesColl As Collection, ByVal SearchDeep As Long)
    ' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
    ' перебор папок осуществляется в том случае, если SearchDeep > 1
    ' добавляет пути найденных файлов в коллекцию FileNamesColl
    On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
    If Not curfold Is Nothing Then    ' если удалось получить доступ к папке


        For Each fil In curfold.Files    ' перебираем все файлы в папке FolderPath
            If fil.Name Like "*" & Mask Xor fil.Name Like "~$*" & Mask Xor fil.Name Like "*" & "db" Then FileNamesColl.Add fil.Path

        Next
        SearchDeep = SearchDeep - 1    ' уменьшаем глубину поиска в подпапках
        If SearchDeep Then    ' если надо искать глубже

        For Each sfol In curfold.SubFolders    ' ' перебираем все подпапки в папке FolderPath
                GetAllFileNamesUsingFSO sfol.Path, Mask, FSO, FileNamesColl, SearchDeep
            Next
        End If
        Set fil = Nothing: Set curfold = Nothing    ' очищаем переменные
    End If
End Function

    Dim Cell As Range
    Dim Cell2 As Range
    
    For Each Cell In Range("B6:B60000")
        If Cell <> "" Then ActiveSheet.Hyperlinks.Add Range("b" & Rows.Count).End(xlUp), ПутьКФайлу
    Next

    For Each Cell2 In Range("B60001:B160000")
        If Cell2 <> "" Then ActiveSheet.Hyperlinks.Add Range("b" & Rows.Count).End(xlUp), ПутьКФайлу
    Next

Function КОД_ПАРТИИ(Код_номенклатуры, Дата_производства)
Dim m As String
Dim y As String
Dim d As String

If Код_номенклатуры = 0 Then
    КОД_ПАРТИИ = "Введите код номенклатуры!"
Exit Function
ElseIf Дата_производства = 0 Then
    КОД_ПАРТИИ = "Введите дату!"
Exit Function
End If

If Month(Дата_производства) = 1 Then
    m = "R"
End If

If Year(Дата_производства) = 2019 Then
    y = "X"
End If

If Day(Дата_производства) = 1 Then
    d = "R"
End If

КОД_ПАРТИИ = m & y & d

End Function

Function TEST1(A, B)
Dim iFullName As String

iFullName = "C:\Program Files\1234.jpg"
If Dir(iFullName) = "" Then
    TEST1 = "ffgg"
    Exit Function
Else
    TEST1 = A & B
End If
End Function