Question

我有以下WB代码，它试图强制用户将文件保存为特定文件类型（.xlsm）和名称（默认路径＆amp;“username-gaplist” - ＆gt;可以跟随ANY在此之后输入）。到目前为止，除了IF语句中的比较运算符的1个问题之外，我几乎已经完成了它的工作。

选项明确

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim txtFileName As String
Dim yn As Boolean
Dim a As String

a = Application.DefaultFilePath & "\" & Environ("UserName") & "-Gaplist.xlsm"

'1. Check of Save As was used.
   If SaveAsUI = True Then
        Cancel = True

'2. Call up your own dialog box.  Cancel out if user Cancels in the dialog box.

       txtFileName = Application.GetSaveAsFilename(Environ("UserName") & "-Gaplist", "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm", , "Save As XLSM file")
       'this compares the named file by user to the restriction which is username and gap list, and cancels if non-confmring

        If Left(txtFileName, Len(txtFileName)) >= Left(a, Len(txtFileName)) Then

           MsgBox Left(txtFileName, Len(txtFileName)) & vbLf & Left(a, Len(txtFileName))

            'if user hits cancel (returns value of "False")
            If txtFileName = "False" Then
            MsgBox "Action Cancelled", vbOKOnly
            Cancel = True
            Exit Sub
            End If

            'if an invalid string is entered
        Else
            MsgBox "Must be saved in following format:" & vbLf & Application.UserName & "-Gaplist" & " " & "(you can add whatever after this)", vbOKOnly, "Retry.."
            Cancel = True
            Exit Sub
        End If

'3. Save the file based on string entered

       Application.EnableEvents = False
       Application.DisplayAlerts = False
        ThisWorkbook.SaveAs Filename:=txtFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.EnableEvents = True
        Application.DisplayAlerts = True

       MsgBox "Saved to: " & txtFileName, vbExclamation, Now

    End If
End Sub

就像我说的，我知道问题在于

左（txtFileName，Len（txtFileName））＆gt; =左（a，Len（txtFileName））

并且取消功能在此设置中正常工作，但我测试了这就是：

输入：username-gaplist.xlsm字符串（已修复）：username-gaplist.xlsm   结果：GOOD（如果已经保存为显示事件，则会覆盖   已关闭）输入：usernam.xlsm字符串（已修复）：   username-gaplist.xlsm结果：好（将给用户的msgbox   告诉他们重试，因为它不符合）

输入：username-gaplist323423.xlsm字符串（已修复）：   username-gaplist.xlsm结果：好（将相应保存   指定的文件路径）

输入：userzzz.xlsm字符串（已修复）：username-gaplist.xlsm结果：    BAD - 这允许用户保存，因为添加“z”表示输入的字符串是＆gt;比固定的字符串（基于   相同的长度），它保存了这个。我想解决这个问题

输入:(用户点击取消）字符串（已修复）：username-gaplist.xlsm   结果：Msgbox操作已取消 - 退出子

我可以尝试的另一件事是使用“LIKE”运算符，但是使用它的经验很少。

任何人提供任何想法/建议都会很棒！

感谢

Answer 1

想出来。

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim txtFileName As String
Dim yn As Boolean
Dim a As String

a = Application.DefaultFilePath & "\" & Environ("UserName") & "-Gaplist"

'1. Check of Save As was used.
   If SaveAsUI = True Then
        Cancel = True

'2. Call up your own dialog box.  Cancel out if user Cancels in the dialog box.

       txtFileName = Application.GetSaveAsFilename(Environ("UserName") & "-Gaplist", "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm", , "Save As XLSM file")
       'this compares the named file by user to the restriction which is username and gap list, and cancels if non-confmring

        If txtFileName = "False" Then
             MsgBox "Action Cancelled", vbExclamation, "Cancelled.."
             Cancel = True
             Exit Sub

        ElseIf Left(WorksheetFunction.Substitute(txtFileName, ".xlsm", ""), Len(a)) = a Then
             GoTo ResumeSub

        ElseIf Left(WorksheetFunction.Substitute(txtFileName, ".xlsm", ""), Len(a)) <> a Then
             MsgBox "Must be saved in the following format: " & Chr(10) & Chr(10) & _
             Environ("username") & "-Gaplist" & "(you can enter whatever text after this)" & vbLf & vbLf & _
             "Note: Not case sensitive!", vbCritical, "Retry.."

             Cancel = True
             Exit Sub

        End If

'3. Save the file.

ResumeSub:

       Application.EnableEvents = False
       Application.DisplayAlerts = False
        ThisWorkbook.SaveAs Filename:=txtFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Application.EnableEvents = True
        Application.DisplayAlerts = True

      MsgBox "Saved to: " & txtFileName & vbLf & vbLf & Space(15) & Date & " " & Time, vbInformation, "Saved!"

    End If
End Sub

VBA保存前事件 - 基于用户输入的文件限制

1 个答案: