Проверка наличия нескольких путей к файлам с использованием диапазона столбцов, а затем запись «ok / nok» - PullRequest
0 голосов
/ 26 октября 2019

Вот сценарий:

  • У меня есть лист, у которого в столбце «A» есть несколько разных путей к папкам
  • Столбец A содержит неизвестное количество строк
  • Структура папок в "C: \ Program Files \ xxxx"
  • .xls файлов в структуре папок "C: \ Program Files \ Year \ Month \ sheet.xls

Мне нужен сценарий VBA для проверки * проверки правильности, если каждый путь к папке в столбце A уже существует, и затем, соответственно, написания "ok" / "nok" в столбце B * проверки, если файл .xls в структуре папокразмещен правильно

Если возможно, лучше иметь подпрограмму для проверки структуры папок и вторую подпрограмму для проверки файла .xls

1 Ответ

0 голосов
/ 27 октября 2019

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

Вам потребуется перейти в Инструменты >> Ссылки и выполнить поиск среды выполнения сценариев Microsoft.

Option Explicit

Sub Check_Folder_Path()
    Dim i As Long, lastRow As Long
    Dim myPath As String

    Dim oFSO As Scripting.FileSystemObject
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    lastRow = Range("A" & Rows.Count).End(xlUp).Row

    For i = 1 To lastRow

        ' Check if the path contains a file. If so, extract only the file path.
        If Right(Cells(i, 1), 3) = "xls" Or Right(Cells(i, 1), 4) = "xlsx" Then
            myPath = Left(Cells(i, 1), InStrRev(Cells(i, 1), "\"))
        Else
            ' Ensure the last character is "\"
            If Right(Cells(i, 1), 1) <> "\" Then
                myPath = Cells(i, 1) & "\"
            Else
                myPath = Cells(i, 1)
            End If
        End If

        ' Check if folder exists
        If oFSO.FolderExists(myPath) = True Then
            Cells(i, 2) = "OK"
        Else
            Cells(i, 2) = "NOK"
        End If

    Next i

    Set oFSO = Nothing
End Sub

Желаем удачи в вашем проекте!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...