Как сделать так, чтобы кнопка «отмена» всплывающего окна Shared LAN Drive работала

Question

У меня есть макрос, посредством которого он извлекает данные из общей локальной сети, однако, если я хочу «отменить» функцию, вместо ускорения команды, я получаю сообщение об ошибке с окном VBA и только с опциями «Завершить», «Отладка» или «Справка».

Какой код мне нужен, чтобы кнопка «Отмена» заработала

Когда я нажимаю «Отмена», я получаю «Ошибка времени выполнения« 1004 »: ошибка

Вот код, который у меня есть:

Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim r, r2 As Range, myCol As String
Dim fd As Office.FileDialog
Dim txtFileName As String

Set ws1 = ThisWorkbook.Sheets(1)

Set fd = Application.FileDialog(msoFileDialogFilePicker)
 With fd
      .AllowMultiSelect = False
      .Title = "Please select the file."
      .Filters.Clear
      .Filters.Add "Excel 2003", "*.csv"
      .Filters.Add "All Files", "*.*"
      If .Show = True Then
        txtFileName = .SelectedItems(1) 'replace txtFileName with your textbox
      End If
End With

Application.Workbooks.Open txtFileName
Set ws2 = ActiveWorkbook.Sheets(1)
ThisWorkbook.Activate

With CreateObject("VBScript.RegExp")
    .Pattern = "^([a-z]|[a-h][a-z]|[a-i][a-v])$"
    .IgnoreCase = True
    Do
        myCol = InputBox("Enter Column")
    Loop While Not .test(myCol)
End With

With CreateObject("Scripting.Dictionary")
    .comparemode = vbTextCompare
    For Each r In ws1.Range(myCol & "37", ws1.Range(myCol & Rows.Count).End(xlUp))
        If IsEmpty(r) = False Then
            For Each r2 In ws2.Range("c2", ws2.Range("c" & Rows.Count).End(xlUp))
                If r2.Value = r.Value Then
                    ws2.Cells(r2.Row, 2).Copy
                    ws1.Cells(r.Row, 3).PasteSpecial xlValues
                    Exit For
                End If
            Next r2
        End If
    Next r
End With

Set ws1 = Nothing: Set ws2 = Nothing

End Sub

Answer 1

Если пользователь отменяет выбор файла, вы можете выйти из кода:

If .Show = True Then
       txtFileName = .SelectedItems(1) 'replace txtFileName with your textbox
Else
       Exit Sub
End If