Excel VBA检查工作表是否存在，如果是，则在工作表名称中添加数字

Question

I would like to say i'm an intermediate user of Excel VBA but i'm struggling with this one.

I have written a script to read a text file and strip out all the information I need and then add it to Worksheet that is named by the text file name and then todays date.

Set WS1 = ActiveWorkbook.Sheets("Home")
myFile = Application.GetOpenFilename()
myFileName = FileNameOf(myFile)
WS1.Copy After:=Sheets(Sheets.Count)
Set WS2 = ActiveSheet
strNewSheetName = myFileName & " - " & Format(Now, "DD-MM-YY")
blnSheetCheck = CheckIfSheetExists(strNewSheetName)
If blnSheetCheck = True Then
    blnDeleteSheet = MsgBox("NOTICE:" & vbCrLf & vbCrLf & "This text file has already been added today!!" & vbCrLf & vbCrLf & "would you like to delete the existing one?", vbYesNo + vbCritical)
    If blnDeleteSheet = vbYes Then
        ActiveWorkbook.Sheets(strNewSheetName).Delete
        WS2.Name = strNewSheetName
    Else
    ' Roll the number here
    End If
Else
    WS2.Name = strNewSheetName
End If

I use this function to check if it exists

Function CheckIfSheetExists(SheetName) As Boolean

CheckIfSheetExists = False
Err.Clear
On Error Resume Next
Set WS99 = Sheets(SheetName)
If Err = 0 Then
    CheckIfSheetExists = True
Else
    CheckIfSheetExists = False
End If

End Function

When I first wrote the code I was going to add a time to the sheet name but it will sometimes push the name over the 31 character limit.

So I would like some guidance on how I can add a numeric to the end of the sheet name and then repeat the process to see if that sheet name exists and then move it up a number and then check again.

Thank you in advance

Andy

Answer 1

This will name the sheets as, for example:
Test 03-05-18 and then Test 03-05-18_01 up to Test 03-05-18_99 .

Update this line to allow more copies:
TempShtName = SheetName & "_" & Format(lCounter, "00")

There's one procedure and two functions in the code:
The first is a copy of your code (with variables declare).
The second figures out the name of the sheet.
The third checks if the sheet exists.

Public Sub Test()

    Dim WrkBk As Workbook
    Dim WS1 As Worksheet, WS2 As Worksheet
    Dim myFile As String
    Dim myFileName As String

    myFile = Application.GetOpenFilename()

    'File name including extension:
    'myFileName = Mid(myFile, InStrRev(myFile, "\") + 1)

    'File name excluding extension:
    myFileName = Mid(myFile, InStrRev(myFile, "\") + 1, InStrRev(myFile, ".") - InStrRev(myFile, "\") - 1)

    With ThisWorkbook
        Set WS1 = .Sheets("Home")
        WS1.Copy After:=.Worksheets(.Worksheets.Count)

        Set WS2 = .Worksheets(.Worksheets.Count)
        WS2.Name = GetSheetName(myFileName & " - " & Format(Now, "dd-mm-yy"))
    End With

End Sub

'Return a numbered sheet name (or the original if it's the first).
Public Function GetSheetName(SheetName As String, Optional WrkBk As Workbook) As String

    Dim wrkSht As Worksheet
    Dim TempShtName As String
    Dim lCounter As Long

    If WrkBk Is Nothing Then
        Set WrkBk = ThisWorkbook
    End If

    TempShtName = SheetName
    Do While WorkSheetExists(TempShtName)
        lCounter = lCounter + 1
        TempShtName = SheetName & "_" & Format(lCounter, "00")
    Loop

    GetSheetName = TempShtName

End Function

'Check if the sheet exists.
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
    Dim wrkSht As Worksheet

    If WrkBk Is Nothing Then
        Set WrkBk = ThisWorkbook
    End If

    On Error Resume Next
        Set wrkSht = WrkBk.Worksheets(SheetName)
        WorkSheetExists = (Err.Number = 0)
        Set wrkSht = Nothing
    On Error GoTo 0

End Function

Edit: To remove illegal characters and keep the sheet name to 31 characters you could add this code in the GetSheetName function just before the TempShtName = SheetName line:

Dim x As Long
Dim sChr As String
Const ILLEGAL_CHR As String = "\/*?:[]"

For x = 1 To Len(SheetName)
    sChr = Mid(SheetName, x, 1)
    If InStr(ILLEGAL_CHR, sChr) > 0 Then
        SheetName = Replace(SheetName, sChr, "_")
    End If
Next x
If Len(SheetName) > 28 Then
    SheetName = Left(SheetName, 28)
End If

Answer 2

Set WS1 = ActiveWorkbook.Sheets("Home")
myFile = Application.GetOpenFilename()
myFileName = FileNameOf(myFile)
WS1.Copy After:=Sheets(Sheets.Count)
Set WS2 = ActiveSheet
strNewSheetName = myFileName & " - " & Format(Now, "DD-MM-YY")
blnSheetCheck = CheckIfSheetExists(strNewSheetName)
If blnSheetCheck = True Then
    blnDeleteSheet = MsgBox("NOTICE:" & vbCrLf & vbCrLf & "This text file has already been added today!!" & vbCrLf & vbCrLf & "would you like to delete the existing one?", vbYesNo + vbCritical)
    If blnDeleteSheet = vbYes Then
        ActiveWorkbook.Sheets(strNewSheetName).Delete
        WS2.Name = strNewSheetName
    Else
     '======Here's the new bit=================
       Dim x as integer
       x = 1
       Do
           strnewsheetname = left(strnewsheetname,30) & x
           blnSheetCheck = CheckIfSheetExists(strNewSheetName)
           x = x +1
       Loop while blnSheetCheck
       WS2.Name = strNewSheetName
    '=============End of New Bit=============
    End If

Else
    WS2.Name = strNewSheetName
End If

Technically this will keep looping above 9, but from you've said I don't think this will be a problem