检查 Excel 列上的文件路径是否正确

Question

我有一个包含多列的 Excel 文件，其中一列包含远程文件夹（或本地，无所谓）中图像的路径。

\\xxx.xxx.xxx.xxx\文件夹\图片.jpg

我想检查所有文件的 URL 或 PATH 是否正确。

如果错误或者没有指向真实文件（或者地址不好），则用红色突出显示（或以某种方式发出信号）。

希望这有意义。我知道我可以使用宏或 VBA 来做到这一点，但我不知道语法。

谢谢！

Answer 1

您可以使用 UDF (用户定义函数) 检查文件路径是否有效。

在 Excel 中，点击ALT+F11打开Visual Basic 编辑器（VBE）。

在 VBA 项目资源管理器»插入»模块中的任意位置单击鼠标右键。

复制并粘贴以下代码

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

现在，返回电子表格视图。进入任意单元格并输入：

=FileExist(A1)

A1保存文件路径的单元格引用在哪里

例如：

此外，您还可以使用条件格式或 VBA 根据值突出显示单元格。

Answer 2

搞清楚了。我相信其他人也会像我今天一样读到这篇文章。你需要两个模块（一个用于提取超链接，一个用于测试文件路径目录）

模块 1（用于超链接）

    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

Module2（用于目录测试）

     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