Проверьте правильность пути к файлу в столбце Excel

У меня есть файл Excel с несколькими столбцами, один из столбцов имеет путь к изображению в удаленной папке (или локальной, не имеет значения).

\\ xxx.xxx.xxx.xxx \ папка \ image.jpg

Я хочу проверить правильность всех URL-адресов или путей к файлам.

Если вы ошиблись или не указали на реальный файл (или адрес неправильный), выделите его красным (или просто как-то сигнализируйте).

Надеюсь, это имеет смысл. Я знаю, что могу сделать это с помощью макросов или VBA, но не знаю синтаксис.

Спасибо!

microsoft-excel vba macros

— villancikos
источник

Ответы:

Вы можете использовать UDF ( пользовательскую функцию ) для проверки правильности пути к файлу.

В Excel нажмите ALT+, F11чтобы включить редактор Visual Basic (VBE).

Щелкните правой кнопкой мыши в любом месте VBA Project Explorer »Вставить» Модуль.

Скопируйте и вставьте приведенный ниже код

Function FileExist(path As String) As Boolean
    If Dir(path) <> vbNullString Then FileExist = True
End Function

Теперь вернитесь к вашему представлению электронной таблицы. Зайдите в любую ячейку и введите:

=FileExist(A1)

где A1ссылка на ячейку, которая содержит путь к файлу

например:

введите описание изображения здесь

Кроме того, вы можете использовать условное форматирование или VBA, чтобы выделить ячейки в зависимости от значения.

подлый трюк, чтобы убрать зависимость от логической переменной по умолчанию: FileExist=Len(Dir(path))>0

— SeanC

@SeanCheshire да, но зачем мне?

Это замечательно! Вау, я не думал, что это было так просто. Но это немного медленно, возможно ли сделать это быстрее, я полагаю, что функция «запускается» постоянно в поисках пути, и, поскольку это удаленный сервер, она потребляет много памяти.

— villancikos

все, что связано с сетевым диском, очевидно, замедлит выполнение. Я, честно говоря, не могу придумать лучшего (простого) решения, может быть, кто-то еще мог. Альтернативой этому было бы сопоставить весь сетевой диск с txt-файлом или массивом и работать в памяти для поиска пути, используя другой подход. это было бы намного сложнее и сложнее.

@ mehow да, конечно, поиск на удаленном диске занимает много времени, но я думаю о запуске формулы один раз. Не как каждый раз. Во всяком случае, вы решили мой вопрос, поэтому вы выиграли: P

— villancikos

Понял это. Я уверен, что другие люди будут читать это, как я сделал сегодня. Вам понадобятся два модуля (один для извлечения гиперссылок и один для проверки пути к файлу)

Module1 (для гиперссылок)

    Function HLink(rng As Range) As String
    'extract URL from hyperlink
     'posted by C.F. Stotch! - shoutout to Richard K!
      If rng(1).Hyperlinks.Count Then HLink = rng.Hyperlinks(1).Address
    End Function

Модуль 2 (для проверки каталога)

     Function FileOrDirExists(PathName As String) As Boolean 'used to test filepaths of commmand button   links to see if they work - change their color if not working
  'Macro Purpose: Function returns TRUE if the specified file
   Dim iTemp As Integer

 'Ignore errors to allow for error evaluation
On Error Resume Next
iTemp = GetAttr(PathName)

 'Check if error exists and set response appropriately
Select Case Err.Number
Case Is = 0
    FileOrDirExists = True
Case Else
    FileOrDirExists = False
End Select

 'Resume error checking
   On Error GoTo 0
    End Function

'' '' 'И НИЖЕ, ЧТО ТО, ЧТО ВЫ ВСТАВИЛИ В ЛИСТ, И АКТИВИРОВАЛИ ЕГО, КАК ВЫ ЖЕЛАЕТЕ, через командную кнопку или как хотите. У меня это автоматически запускается, когда рабочий лист активирован :) Ура!

     Private Sub TestFilesExist()
   Dim xCheck As Integer
  'starting in the 3rd row....
 xCheck = 3
   On Error GoTo 0
    'Debug.Print Range("A" & xCheck).Value
    While xCheck < 36

       'xPather - checks if Z1 is a good path and then either highlights the actual cell in A column red if bad, or no fill if good.
      Dim sPath As String
      Dim XPather As String

'need a cell to put the hyperlink addresses into during the loop check as was not able to find the hyperlink address straight out of the cell containing the hyperlink. Extraction if you will. :)

ThisWorkbook.Sheets(1).Range("Z1").Value = "=HLink(A" & xCheck & ")"
XPather = ThisWorkbook.Sheets(1).Range("Z1").Value

Debug.Print XPather

 'Tests if directory or file exists
If FileOrDirExists(XPather) = False Then
    Range("A" & xCheck).Interior.ColorIndex = 3
Else
    Range("A" & xCheck).Interior.ColorIndex = xlNone
End If

    xCheck = xCheck + 1
    Wend

    End Sub

— user419687
источник