确保文件名以特定字符串开头

时间:2016-07-14 21:05:55

标签: vba excel-vba excel

我一直在玩这个代码。理想情况下,我可以强制用户将文件名保存为从Lowpar开始,尽管我可以解决这个问题,因为代码无法正常工作。例如,我想调用文件Lowpar2016但是使用此代码它将无法工作。

.row

2 个答案:

答案 0 :(得分:3)

以下重构代码会强制该名称以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

答案 1 :(得分:0)

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