取消并不意味着它是一个错误

Question

我希望大家都过得愉快。我的代码在这里有问题。此处的代码将显示一个文件对话框，并要求用户选择文件，效果很好。我的问题是，当它显示文件对话框时，我不想单击所需的文件夹，而是单击“取消”。但是，当我单击“取消”时，将出现运行时错误，指出“下标超出范围”。它将打开一个带有ts-event.log标题的excel文件

因此，我尝试通过使用错误处理On Error GoTo来克服此问题。因此，我将收到一个消息框，说“您已取消操作”，而不是VBA的默认消息框。但我仍然打开了ts-event.log Excel文件。如何避免这种情况？有人能帮我吗。预先谢谢你。

Sub UploadData()

Dim SummWb As Workbook
Dim SceWb As Workbook

'Get folder containing files
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    On Error Resume Next
    myFolderName = .SelectedItems(1)
    'Err.Clear
    On Error GoTo Error_handler
End With

If Right(myFolderName, 1) <> "\" Then myFolderName = myFolderName & "\"
    'Settings
    Application.ScreenUpdating = False
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Set SummWb = ActiveWorkbook
    'Get source files and append to output file
    mySceFileName = Dir(myFolderName & "*.*")

        Do While mySceFileName <> "" 'Stop once all files found
            Application.StatusBar = "Processing: " & mySceFileName
            Set SceWb = Workbooks.Open(myFolderName & mySceFileName) 'Open file found
                With SummWb.Sheets("Master List")
                    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B1").Value
                    .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B2").Value
                    .Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B3").Value
                    .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B4").Value
                    .Cells(.Rows.Count, "H").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C7").Value
                    .Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D7").Value
                    .Cells(.Rows.Count, "J").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C8").Value
                    .Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D8").Value
                    .Cells(.Rows.Count, "L").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C9").Value
                    .Cells(.Rows.Count, "M").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D9").Value
                    .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0).Value = SummWb.Sheets("Upload Survey").Range("C8").Value
                End With
            SceWb.Close (False) 'Close Workbook
            mySceFileName = Dir

       Loop
Error_handler:
MsgBox ("You cancelled the action.")

MsgBox ("Upload complete.")

'Settings and save output file
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
SummWb.Activate
SummWb.Save 'save automaticallly
Application.ScreenUpdating = True

End Sub

Answer 1

取消并不意味着它是一个错误

Sub UploadData()

Dim SummWb As Workbook
Dim SceWb As Workbook
Dim myFolderName As String
Dim oldstatusbar As Boolean
Dim mySceFileName As String

On Error GoTo Error_handler
'Get folder containing files
With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then
        .AllowMultiSelect = False
        myFolderName = .SelectedItems(1)
      Else 'You clicked cancel
        GoTo Cancel_handler
    End If
End With

If Right(myFolderName, 1) <> "\" Then myFolderName = myFolderName & "\"
   'Settings
    Application.ScreenUpdating = False
    oldstatusbar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Set SummWb = ActiveWorkbook
    'Get source files and append to output file
    mySceFileName = Dir(myFolderName & "*.*")

        Do While mySceFileName <> "" 'Stop once all files found
            Application.StatusBar = "Processing: " & mySceFileName
            Set SceWb = Workbooks.Open(myFolderName & mySceFileName) 'Open file found
                With SummWb.Sheets("Master List")
                    .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B1").Value
                    .Cells(.Rows.Count, "B").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B2").Value
                    .Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B3").Value
                    .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B4").Value
                    .Cells(.Rows.Count, "H").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C7").Value
                    .Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D7").Value
                    .Cells(.Rows.Count, "J").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C8").Value
                    .Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D8").Value
                    .Cells(.Rows.Count, "L").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C9").Value
                    .Cells(.Rows.Count, "M").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D9").Value
                    .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0).Value = SummWb.Sheets("Upload Survey").Range("C8").Value
                End With
            SceWb.Close (False) 'Close Workbook
            mySceFileName = Dir

       Loop

  SummWb.Activate
  SummWb.Save 'save automaticallly
  MsgBox ("Upload complete.")
Finish:
  Application.StatusBar = False
  Application.DisplayStatusBar = oldstatusbar
  Application.ScreenUpdating = True
  Exit Sub
Cancel_handler:
  MsgBox "You cancelled the action."
  Exit Sub
Error_handler:
  MsgBox "An unexpected error occurred."
  GoTo Finish
End Sub

请注意第一个Exit Sub：如果没有错误发生，程序将在此结束。如果单击取消按钮，它将显示消息框，并在第二个Exit Sub处结束。但是，如果发生错误，则将其带回Goto Finish，并在其中包含所有使应用程序回到初始状态的语句。

取消文件对话框提示Excel打开Excel日志文件

1 个答案:

取消并不意味着它是一个错误