打开文件对话框上的取消按钮不关闭Visual Basic窗口

时间:2016-08-17 17:14:24

标签: excel vba ms-access openfiledialog cancel-button

我正在写一个窗口,要求提示让用户保存文件。它关闭并询问是否要覆盖文件,除非我按下取消它仍然卡在while循环中。有谁知道取消/关闭窗口的代码?

Private Sub btn_Browse1_Click()

  Dim strFilter As String
Dim strOutputFileName As String, compareFileName As String, response As Integer, fileSet As Boolean

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xlsx)", "*.xlsx")

fileSet = False
While fileSet = False
    strOutputFileName = ahtCommonFileOpenSave( _
                        Filter:=strFilter, _
                        OpenFile:=False, _
                        DialogTitle:="Choose an image file...", _
                        Flags:=ahtOFN_HIDEREADONLY)


        If Len(strOutputFileName) > 0 Then
        compareFileName = Dir(strOutputFileName)
        If compareFileName <> "" Then 'find exist file with the same name
            response = MsgBox("The current file name already exists. Do you want to replace the file " & strOutputFileName & " with the current one?", vbYesNo)
            If response = vbYes Then
                fileSet = True      'replace old file
                Kill strOutputFileName
            Else
                fileSet = False
            End If
        Else 'no file exists with the same name
            fileSet = True
        End If

    End If
Wend
Me.txt_File_Level1.Value = strOutputFileName

1 个答案:

答案 0 :(得分:0)

你的fileSet在你的else子句中等于False

If response = vbYes Then
    fileSet = True
Else
    fileSet = False
End If

我首先用do / while循环替换,因为如果我没记错的话,你只能用GOTO语句提前退出。

Dim strFilter As String
Dim strOutputFileName As String, compareFileName As String, response As Integer, fileSet As Boolean

strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xlsx)", "*.xlsx")

fileSet = False
Do While fileSet = False
    strOutputFileName = ahtCommonFileOpenSave( _
                    Filter:=strFilter, _
                    OpenFile:=False, _
                    DialogTitle:="Choose an image file...", _
                    Flags:=ahtOFN_HIDEREADONLY)


    If Len(strOutputFileName) > 0 Then
        compareFileName = Dir(strOutputFileName)
        If compareFileName <> "" Then 'find exist file with the same name
            response = MsgBox("The current file name already exists. Do you want to replace the file " & strOutputFileName & " with the current one?", vbYesNo)
            If response = vbYes Then
                fileSet = True      'replace old file
                Kill strOutputFileName
            Else
                fileSet = False
                Exit Do
            End If
        Else 'no file exists with the same name
            fileSet = True
        End If
    End If
Loop
Me.txt_File_Level1.Value = strOutputFileName