ファイル名を保証するには、特定の文字列で始まる

Question

私はこのコードで遊んでいます。理想的には、Lowparで始まるファイル名をユーザーに強制的に保存させることができますが、コードが効果的に機能しない場合があります。例えば、私はLowpar2016ファイルを呼び出したいが、このコードではうまくいきません。

Private Sub Workbook_BeforeSave _ 
(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
Dim NamePath As String 
Dim strName As String 
Dim lFind As Long 

    If SaveAsUI = True Then' unless this is set to <> true, it does not work 
     Cancel = True 
     With Application 
      .EnableEvents = False 
      NamePath = .GetSaveAsFilename 
      strName = Mid(NamePath, InStrRev(NamePath, "\", -1, vbTextCompare) + 1, 256) 

      If NamePath = "False" Then' this is part of the code that confuses me 
       .EnableEvents = True 
       Exit Sub 
      ElseIf left(strName,6) <> "Lowpar" Then 
       MsgBox "You cannot save as another name" 
       .EnableEvents = True 
       Exit Sub 
      Else 
       Me.SaveAs NamePath 
       .EnableEvents = True 
      End If 
     End With 
    End If 
End Sub 

Answer 1

以下のリファクタリング、コードがまだしていない場合LowParで開始する名前を強制します：

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

Dim NamePath As String 
Dim strName As String 
Dim lFind As Long 

    If SaveAsUI = True Then ' unless this is set to <> true, it does not work 

    Cancel = True 
    With Application 

     .EnableEvents = False 
     NamePath = .GetSaveAsFilename 
     strName = Mid(NamePath, InStrRev(NamePath, "\", -1, vbTextCompare) + 1, 256) 

     If NamePath = "False" Then ' this is part of the code that confuses me 
      .EnableEvents = True 
      Exit Sub 
     ElseIf Left(strName, 6) <> "Lowpar" Then 
      NamePath = "LowPar_" & NamePath 
     End If 

     Me.SaveAs NamePath 
     .EnableEvents = True 

    End With 

    End If 

End Sub 

Answer 2

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean) 
Dim NamePath As String 
Dim strName As String 
Dim lFind As Long 
Dim NewName As String 

    If SaveAsUI = True Then 

    cancel = True 
    With Application 

     .EnableEvents = False 
     NamePath = .GetSaveAsFilename 
     strName = Mid(NamePath, InStrRev(NamePath, "\", -1, vbTextCompare) + 1, 256) 
     NamePath = Left(NamePath, InStrRev(NamePath, "\")) 

     If NamePath = "False" Then 
      .EnableEvents = True 
      Exit Sub 
     ElseIf Left(strName, 6) <> "Name" Then 

     NewName = InputBox("The filename """ & strName & """ is incorrect" & vbNewLine & _ 
          "Please input a name below starting with Name" & vbNewLine & _ 
          "For instance, Name and other things" & vbNewLine & _ 
          "Do not include any extension, i.e., .xlsm", "Rename", "Name") 
     If Left(NewName, 6) = "Name" Then 
      strName = NewName & ".xlsm" 
     End If 

     Me.SaveAs NamePath & strName 
     .EnableEvents = True 

     End If 
    End With 

    End If 
End sub