Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA проверка существования файла по гиперссылке
 
#1
04.02.2018 08:26:19
Всем доброго  утра. Подскажите пожалуйста, как с помощью VBA реализовать проверку существования файла.
в примере приложил образец как примерно должно получиться
 
 
 
#2
04.02.2018 09:44:40
Два варианта. В Вашем случае Книга должна находиться в той же папке, что и проверяемые файлы
Код
'для Вашего случая (гиперссылки формулой)
Sub CheckFileFHyperlink()
Dim cl As Range
lRow = Cells(Rows.Count, 2).End(xlUp).Row
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each cl In Range("B1:B" & lRow).Cells
    If cl.Formula Like "=HYPERLINK*" Then
        cl.Offset(, 1) = IIf(Not FSO.FileExists(ThisWorkbook.Path & Application.PathSeparator & cl.Value & ".txt"), "not found", "ok")
    End If
Next
End Sub

'для обычных гиперссылок
Sub CheckFileHyperlink()
Dim hl As Hyperlink
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each hl In ActiveSheet.Hyperlinks
    hl.Parent.Offset(, 1) = IIf(Not FSO.FileExists(hl.Address), "not found", "ok")
Next
End Sub
Изменено: Sanja - 04.02.2018 09:48:22
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
04.02.2018 10:17:18
Sanja, так не интересно. Вот как по простому и универсально вычислить путь указанный в первом параметре функции? У меня только одна крамольная мысль была, это положить эту часть формулы в отдельную свободную ячейку листа от куда вызывается функция и считать её значение. Далее то все просто.
Изменено: БМВ - 04.02.2018 10:17:46
По вопросам из тем форума, личку не читаю.
 
 
 
#4
04.02.2018 10:31:43
Sanja Всё отлично, всё работает! спасибо большое.
Ещё подскажите пожалуйста как реализовать если файлы раскиданы по определенным папкам?
например если
file_1.txt находиться в папке folder_1
file_2.txt находиться в папке folder_2
а рабочая книга находиться в корневой папке. Спасибо
 
 
 
#5
04.02.2018 10:39:13
вот и вернулись к
Цитата
БМВ написал:
Вот как по простому и универсально вычислить путь указанный в первом параметре функции?
По вопросам из тем форума, личку не читаю.
 
 
 
#6
04.02.2018 10:44:39
Цитата
Il'nar написал: как реализовать если...
Какой пример - такое и решение.
Цитата
БМВ написал: вот и вернулись
БМВ, я стараюсь не додумывать за ТСа без особой на то необходимости
Код
'для Вашего случая (гиперссылки формулой)
Sub CheckFileFHyperlink()
Dim cl As Range
lRow = Cells(Rows.Count, 2).End(xlUp).Row
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each cl In Range("B1:B" & lRow).Cells
    If cl.Formula Like "=HYPERLINK*" Then
        iPath = Evaluate(Mid$(Split(cl.Formula, ",")(0), 12))
        cl.Offset(, 1) = IIf(Not FSO.FileExists(iPath), "not found", "ok")
    End If
Next
End Sub
Изменено: Sanja - 04.02.2018 10:47:39
Согласие есть продукт при полном непротивлении сторон
 
 
 
#7
04.02.2018 10:53:13
Sanja огромное спасибо. Вы мне очень помогли! то что надо.
 
 
 
#8
04.02.2018 11:08:27
Не, Виталь, с файлом из #1 не работает.
Лучше мяукнуть
Код
Function Мяу$(r As Range)
    Dim s$, hpl$, ls&
    If InStr(r.Formula, "HYPERLINK") Then
        s = Mid(r.Formula, InStr(r.Formula, "HYPERLINK") + 10)
        s = Evaluate(Left(s, InStr(s, ",") - 1))
        If Left(s, 1) = "." Then
            ls = Len(Left(s, InStrRev(s, "\") - 1))
            If ls = 1 Then
                hpl = ThisWorkbook.Path & Mid(s, InStrRev(s, "\"))
            ElseIf ls = 2 Then
                hpl = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1) & Mid(s, InStrRev(s, "\"))
            End If
        Else
            hpl = s
        End If
        Мяу = IIf(Dir(hpl) <> "", "ok", "not found")
    End If
End Function
 
 
 
#9
04.02.2018 11:11:06
Цитата
RAN написал: с файлом из #1 не работает.
Да, но там и не указана папка
Согласие есть продукт при полном непротивлении сторон
 
 
 
#10
04.02.2018 11:13:25
Как не указана? А "." ? И может быть еще "..".
 
 
 
#11
04.02.2018 11:28:06
UDF , есть заимствование у Sanja,
Код
Function CheckFileFHyperlink(HyperlinkFormula As Range) As String
Dim strPatyh As String
    If HyperlinkFormula.Count = 1 Then
        With HyperlinkFormula
            strPath = Evaluate(Mid$(Split(.Formula, ",")(0), 12))
            strPath = IIf(Left(strPath, 2) = ".\", .Parent.Parent.Path & Right(strPath, Len(strPath) - 1), strPath)
            CheckFileFHyperlink = IIf(Not CreateObject("Scripting.FileSystemObject").FileExists(strPath), "not found", "ok")
        End With
    End If
End Function
По вопросам из тем форума, личку не читаю.
 
 
 
#12
04.02.2018 11:31:57
БМВ вообще идеально! Спасибо!
 
 
 
#13
04.02.2018 11:43:41
Цитата
RAN написал:
И может быть еще "..".
к стати да, я тоже это не учел.
По вопросам из тем форума, личку не читаю.
 
 
 
#14
04.02.2018 11:48:44
Миш,
=ГИПЕРССЫЛКА(".."&A1&".txt";"мойТекст")
????
 
 
 
#15
04.02.2018 12:23:19
Цитата
RAN написал:
(".."&A1
такого быть не должно. Если  только =ГИПЕРССЫЛКА("..\"&A1&".txt";"мойТекст")
тогда прибавим строк
Код
Function CheckFileFHyperlink(HyperlinkFormula As Range) As String
Dim strPatyh As String
Dim objFSO As Object
    If HyperlinkFormula.Count = 1 Then
    Set objFSO = CreateObject("Scripting.FileSystemObject")
        With HyperlinkFormula
            strPath = Evaluate(Mid$(Split(.Formula, ",")(0), 12))
            strPath = IIf(Left(strPath, 2) = ".\", .Parent.Parent.Path & Right(strPath, Len(strPath) - 1), strPath)
            strPath = IIf(Left(strPath, 3) = "..\", objFSO.getfolder(.Parent.Parent.Path).parentfolder.Path & _
                Right(strPath, Len(strPath) - 2), strPath)
            CheckFileFHyperlink = IIf(Not objFSO.FileExists(strPath), "not found", "ok")
        End With
    End If
End Function
Изменено: БМВ - 04.02.2018 12:24:26
По вопросам из тем форума, личку не читаю.
 
 
 
#16
04.02.2018 12:46:20
Интересное кино...
В файле формула со слешем, тут без...
Мыши на форуме?
 
 
 
#17
04.02.2018 13:31:50
Offtop
Цитата
RAN написал:
Мыши на форуме?
Кот из дому - мыши в пляс :-)
По вопросам из тем форума, личку не читаю.
 
 
 
#18
16.07.2021 14:43:28
Приветствую, возможно скорректировать код под проверку ссылок в выделенной области?
 
 
 
Страницы: 1
Читают тему
Наверх