VBA Beforeイベント保存 - ユーザエントリに基づくファイル制限

Question

次のWBコードを使用して、特定のファイルタイプ（.xlsm）と名前（デフォルトパス& "username-gaplist" " - >の後にANYタイプを続けることができます）。これまでのところ、IFステートメントの比較演算子での1つの問題を除いて、ほぼ確実に処理しています。

私は問題が

左（txtFileName、レン（txtFileName））であることを知って、

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） ）

及びキャンセル機能このセットアップで正しく動作しますが、私がテストして、これは何が起こるかです：

は、入力された：（固定）ユーザ名gaplist.xlsm文字列：ユーザー名-gaplist.xlsm 結果：GOOD（すでに表示イベントとして保存している場合は上書きされます がオフになってます）入社：usernam.xlsm文字列（固定）： をユーザ名gaplist.xlsm結果：グッド（ユーザーはそれが適合していないと再試行するためにそれらを伝えるメッセージボックス だ与える）

を入力：ユーザ名gaplist323423.xlsm文字列（固定）： ユーザ名gaplist.xlsm結果を：良い（指定されたファイルパス に応じて保存されます）

入力：userzzz.xlsm Strin g（fixed）：username-gaplist.xlsm result： BAD - 「z」を追加すると、固定長の文字列よりも>（ の長さに基づく）という意味で、を保存することができます。それはこれを保存します。私は試みることができる他の事をしているサブ

を終了 - キャンセルのMsgBoxアクション：（ユーザーのヒットキャンセル）文字列（固定）：ユーザ名gaplist.xlsm 結果、私はこの

入力したが、修正したいと思います「LIKE」演算子を使用しますが、これを使用する経験はほとんどありません。

意見や提案があれば誰でも提供してくれます。

THanks

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