Пользовательская форма VBA для проверки наличия файла в выбранной папке - PullRequest
0 голосов
/ 22 мая 2019

Мы копируем PDF-файлы из основной папки в назначенную папку проекта. Я создал пользовательскую форму, которая позволяет пользователю проверять наличие PDF-файла на основе значения в строке 'B'

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

Private Sub slctfldrcmd_Click()
    Dim fldr As FileDialog
    Dim sItem As String

    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        '.InitialFileName = Application.GetSaveAsFilename()

        If .Show <> -1 Then GoTo NextCode

        sItem = .SelectedItems(1)
    End With

NextCode:
    GetFolder = sItem
    choosefldrtb.Value = sItem

    Set fldr = Nothing
End Sub


Private Sub runcmd_Click()
    'ActiveSheet.Columns("H:K").ClearContents

    Dim ws As Worksheet
    Dim R As Range

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = True
    End With

    For Each R In Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row)
        If R <> vbNullString Then ActiveSheet.Hyperlinks.Delete       
    Next R

    For Each R In Range("G2:G" & Cells(Rows.Count, "G").End(xlUp).Row)
        If R <> vbNullString Then Columns("J").ClearContents     
    Next R

    For Each ws In ThisWorkbook.Worksheets
        Dim c As Range

        For Each c In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
            If c <> vbNullString Then
                c.Offset(0, 8).Value = "=IF(FileExists4(RC[-8]), ""ok"", ""missing"")"
            End If
        Next c
    Next ws

    'Call Draw_Clean 
    'Call Hyperlinks2

    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

    'MsgBox "PDF's Checked"          
    MsgBox "Drawings in " & choosefldrtb.Value & "  Checked"        
End Sub


Function FileExists4(sFile As String)     
    sPath = FldrChkuserform.choosefldrtb.Value & "\" & sFile & ".PDF"
    FileExists4 = Dir(sPath) <> ""
End Function

В настоящий момент все работает, кроме возвращаемого значения в столбце 'J', в котором должно быть указано «ок» или «пропущено». Все, что происходит, это «#NAME?» Я думаю, что это как-то связано со значением в текстовом поле, которое не передается в функцию 'FileExists4'?

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