VBA - 检查文件是否存在而不知道扩展名

时间:2018-06-06 06:26:34

标签: excel vba search

我有一个excel工作簿,列[A]有很多文件名。但只有文件名,所以没有任何扩展名。我想遍历每个单元格并检查特定文件夹中的文件是否与单元格中的此字符串匹配。

有人无法在Google上找到任何内容。

谢谢

2 个答案:

答案 0 :(得分:1)

这应该这样做。

Const dirPath As String = "C:\whateveryourPathIs\"

Sub RunIt()
    Dim Rcell As Range
    For Each Rcell In Intersect(Range("A:A"), ActiveSheet.UsedRange).Cells

        If Not IsEmpty(Rcell) Then

            If CheckIfFileExists(dirPath, Rcell.Value) Then
                'whatever you want to happen when it finds a match
                Debug.Print Rcell.Value & " was found"

            End If
        End If

    Next Rcell

End Sub



Private Function CheckIfFileExists(srchDIR As String, MatchMember As String) As Boolean
    Dim file As Variant, nameOfFile As String

    If Right(srchDIR, 1) <> "\" Then srchDIR = srchDIR & "\"

    file = Dir(srchDIR)
    While (file <> "")

        nameOfFile = Left(file, InStrRev(file, ".", -1, vbTextCompare) - 1)


        If UCase(nameOfFile) = UCase(MatchMember) Then
            CheckIfFileExists = True
            Exit Function
        End If

        file = Dir
    Wend
End Function

答案 1 :(得分:0)

@PGCodeRider谢谢,我根据自己的需要修改了代码,现在可以使用了。任何对代码感兴趣的人(“或者在谷歌上找不到任何东西”):

Const dirPath As String = "C:\folderpath\..."

Sub RunIt()
    Dim Rcell As Range
    For Each Rcell In Intersect(Range("A:A"), ActiveSheet.UsedRange).Cells

        If Not IsEmpty(Rcell) Then

            If CheckIfFileExists(dirPath, Rcell.Value) Then
                'whatever you want to happen when it finds a match
                Debug.Print Rcell.Value & " was found"

            End If
        End If

    Next Rcell

End Sub

Private Function CheckIfFileExists(srchDIR As String, MatchMember As String) As Boolean
    Dim file As Variant
    Dim length As Long

    If Right(srchDIR, 1) <> "\" Then srchDIR = srchDIR & "\"

        file = Dir(srchDIR)

        While (file <> "")

            length = Len(file)
                For i = 1 To length
                    If Right(file, 1) <> "." Then
                        file = Left(file, length - 1)
                        length = Len(file)
                    Else
                    Exit For
                    End If
                Next i

            file = Left(file, length - 1)

        'If InStr(1, file, MatchMember, vbTextCompare) > 0 Then
            If file = MatchMember Then
                CheckIfFileExists = True
                Exit Function
            End If
            file = Dir
        Wend
End Function