VBA - проверить, существует ли файл, не зная расширения - PullRequest
0 голосов
/ 06 июня 2018

У меня есть книга Excel с колонкой [A] с многочисленными именами файлов.Но только имя файла, поэтому без каких-либо расширений.Я хотел бы пройтись по каждой ячейке и проверить, существует ли файл в определенной папке, соответствующий этой строке в ячейке.

кому-то не удалось найти что-либо в Google.

спасибо

Ответы [ 2 ]

0 голосов
/ 06 июня 2018

@ PGCodeRider Спасибо, я изменил ваш код в соответствии со своими потребностями, и теперь он работает.Любой, кто заинтересован ("или также не нашел ничего в Google") под кодом:

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
0 голосов
/ 06 июня 2018

Это должно сделать это.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...