CODEWITHSUNDEEP
vbaexcel
Lowpar
Lowpar

Reputation: 907

Assuring a filename starts with a particular string

I have been playing around with this code. Ideally, I would be able to force the user to save the filename as starting with Lowpar, although I can get this to happen the code does not work effectively. For instance, I would like to call the file Lowpar2016 but with this code it will not work. 

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

Upvotes: 1

Views: 46

Answers (2)

Lowpar
Lowpar

Reputation: 907

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

Upvotes: 0

Scott Holtzman
Scott Holtzman

Reputation: 27239

The below refactored code will force the name to start with LowPar if it doesn't already:

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

Upvotes: 3

Related Questions