VBA для обработки ошибок, если открытие исходного файла не было успешным - PullRequest
Новая
       26

VBA для обработки ошибок, если открытие исходного файла не было успешным

0 голосов
/ 20 марта 2020

Я изменил коды из учебника YouTube (https://www.youtube.com/watch?v=h_sC6Uwtwxk, спасибо), чтобы импортировать данные из других файлов Excel. 

Sub get_data_from_source_file()

Dim FileToOpen As Variant
Dim SrcWB As Workbook
Dim SrcWS As Worksheet
Dim SrcRng As String
Let SrcRng = "A2:I501"
Dim DesWB As Workbook
Dim DesWS As Worksheet
Set DesWS = Worksheets("MAIN")
Dim DesLR As Long
DesLR = Application.WorksheetFunction.CountA(DesWS.Range("A1:A50001"))
Dim DesRng As String  
Let DesRng = "A" & DesLR + 1 & ":" & "I" & DesLR + 500
Dim sFileName As String

Application.ScreenUpdating = False

FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", filefilter:="Excel Files (*.xlsx;.*.csv*),*xlsx;csv*")
If FileToOpen <> False Then
On Error GoTo WrongPWD
Set SrcWB = Application.Workbooks.Open(FileToOpen)
ThisWorkbook.Worksheets("MAIN").Range(DesRng) = SrcWB.Sheets(1).Range(SrcRng).Value
SrcWB.Close False
MsgBox "Data import was successful."
End If

WrongPWD: 

        If Err.Number = 1004 Then

        Dim MsgPrompt As String
        MsgPrompt = "The file could not be opened. Try again?"
        Select Case MsgBox(prompt:=MsgPrompt, Buttons:=vbYesNoCancel, Title:="Decision")
        Case Is = vbYes: 'Do nothing and let the code loop
        Case Is = vbNo: Exit Sub
        Case Else: Exit Sub 'User canceled (includes VbCancel and pressing the x top right corner)
        End Select


        Exit Sub

        End If

Application.ScreenUpdating = True

End Sub

Код работает нормально. Мои исходные файлы, однако, могут как-то быть защищены паролем. Когда я ввожу неверный пароль, код прекращается. Просьба сообщить мне коды для обработки этой ошибки, такие как запрос msgbox, уведомление пользователя о необходимости запустить команду и выйти из sub, et c?

1 Ответ

0 голосов
/ 20 марта 2020

Вот пример того, как вы могли бы сделать это: 

Dim wb As Workbook

Do While wb Is Nothing
    On Error Resume Next
        Set wb = Workbooks.Open(FilePath)
    On Error GoTo 0
    If wb Is Nothing Then
        Dim MsgPrompt As String
        MsgPrompt = "The file could not be opened. Try again?"
        Select Case MsgBox(prompt:=MsgPrompt, Buttons:=vbYesNoCancel, Title:="Decision")
            Case Is = vbYes: 'Do nothing and let the code loop
            Case Is = vbNo: Exit Sub
            Case Else: Exit Sub 'User canceled (includes VbCancel and pressing the x top right corner)
        End Select
    End If
Loop
...