vba - VBA-基于文件名创建新图纸的错误处理

Question

我得到下面的代码来根据文件夹中的文件创建和命名工作表:

链接:Creating Worksheets based on Filenames

Sub test()
  Dim Filenames As Variant, strFilename As Variant, strPath As String
  Dim i As LongPtr

  strPath = "D:\myPath"
  strFilename = Dir(strPath & "\" & "*.xlsx")
  Do Until strFilename = ""
    Filenames = Filenames & "|" & strFilename
    strFilename = Dir
  Loop

  Filenames = Mid(Filenames, 2)
  Filenames = Split(Filenames, "|")  ' <- all .xlsx filenames in this array

  For i = LBound(Filenames) To UBound(Filenames)
    with Worksheets.Add 
      .name = Left(Filenames(i), Len(Filenames(i)) - 5)
    end with
  Next i

End Sub

但是，我现在需要针对以下内容的错误处理:

1)如果工作表名称已经存在

2)通过文件名排除目录中的某些文件-这不是一个大问题，但是如果可以做到的话，那确实很棒

这是第一个问题的一些代码-但由于参数是字符串，我不知道如何实现它:

Function sheetExists(sheetToFind As String) As Boolean
    sheetExists = False
    For Each Sheet In Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet
End Function

这是第二个问题的代码:

For i = LBound(Filenames) To UBound(Filenames)

        Do While Filenames <> "test.xlsx"

            With x.Worksheets.Add
            .Name = Left(Filenames(i), Len(Filenames(i)) - 5)
        Loop

    End With

    Next i

使用 Do While或 If Else语句，我不断收到错误:

Loop without Do While

要么

End If without Block If

要么

Else Without If

我也在以下2个链接中发布了此问题:

http://www.tek-tips.com/viewthread.cfm?qid=1785646

https://www.experts-exchange.com/questions/29091353/Creating-Worksheets-based-on-Filenames.html?anchor=a42513369&notificationFollowed=205670107#a42513369

Answer 1

我认为您在以下代码之后:

Option Explicit

Sub test()

Dim strFilename As String
Dim strPath As String
Dim WB As Workbook

Set WB = ThisWorkbook ' define which workbook you want to add the sheets
strPath = "D:\myPath\"
strFilename = Dir(strPath & "*.xlsx")

Do Until strFilename = ""
    strFilename = Split(strFilename, ".")(0)

    ' check is strFilename already exists in existing sheets

    If sheetExists(strFilename) = False Then ' doesn't exist
        WB.Sheets.Add(After:=WB.Sheets(WB.Sheets.Count)).Name = strFilename
    Else
        ' just raise a message box
        MsgBox "Worksheet " & strFilename & " already exists.", vbInformation
    End If
    strFilename = Dir
Loop

End Sub 

Function sheetExists(sheetToFind As String) As Boolean

    sheetExists = False
    For Each Sheet In Worksheets
        If sheetToFind = Sheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next Sheet

End Function