如何导出多个工作表并将其保存在与工作簿标题相同的新创建的文件夹中

Question

试图通过循环将工作表导出为pdf并将其保存在新创建的文件夹中，该文件夹与活动工作簿的名称相同。代码在以前的文件中有效，但现在不再循环或保存在新文件夹中。它创建文件夹，然后将活动工作表导出为pdf。

当我运行它时，我会得到运行时错误5，但只有当我让它作为循环运行时

我已经尝试了不同的文件名（活动workbook.path和“ \”＆）以及创建新文件夹（MkDir）的不同方法

Sub ExportAsPDFAndSaveInNewFolder()

    Dim wbA     As Workbook
    Dim wsA As Worksheet
    Dim tdate As String

    Dim fso As Object
    Dim fldrName As String
    Dim fldrpath As String

    Dim myFile  As String

    Dim CF As Long, CV As Long, RF As Long, RV As Long
    Dim Col As Long, Rw As Long
    Dim path As String

    Dim response As VbMsgBoxResult

    ' Set WS_Count equal to the number of worksheets in the active workbook.
    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet
    tdate = "Dec"

    'create new folder
    Set fso = CreateObject("scripting.filesystemobject")
        fldrName = wbA.name
        fldrpath = ActiveWorkbook.path & "\" & Left(wbA.name, InStr(wbA.name, "."))
        If Not fso.folderexists(fldrpath) Then
        fso.createfolder (fldrpath)
        End If

    ' Begin the loop.
    For Each wsA In wbA.Sheets
        wsA.Activate

         'create a default name for saving file
          myFile = "R Ch - S " & Year(Date) & " YTD " & tdate & " " & ActiveSheet.name & ".pdf"

            if wsA.name <> "Top 25" and wsA.name <> "Top 10" then
              ActiveSheet.ExportAsFixedFormat _
                        Type:=xlTypePDF, _
                        Filename:=**ActiveWorkbook.path & "\" & myFile, _**
                        (Filename:= fldrpath & myfile, _)
                        Quality:=xlQualityStandard, _
                        IncludeDocProperties:=True, _
                        IgnorePrintAreas:=False, _
                        OpenAfterPublish:=False
                With ActiveSheet
    CF = .Cells.Find(What:="*", After:=Range("A1"), 
         LookIn:=xlFormulas, _
         LookAt:=xlPart, SearchOrder:=xlByColumns,
         SearchDirection:=xlPrevious).Column
    CV = .Cells.Find(What:="*", After:=Range("A1"), 
         LookIn:=xlValues, _
         LookAt:=xlPart, SearchOrder:=xlByColumns, 
         SearchDirection:=xlPrevious).Column
    RF = .Cells.Find(What:="*", After:=Range("A1"), 
         LookIn:=xlFormulas, _
         LookAt:=xlPart, SearchOrder:=xlByRows,
         SearchDirection:=xlPrevious).Row
    RV = .Cells.Find(What:="*", After:=Range("A1"),
         LookIn:=xlValues, _
         LookAt:=xlPart, SearchOrder:=xlByRows,

         SearchDirection:=xlPrevious).Row

                   Col = Application.WorksheetFunction.Max(CF, CV)
                   Rw = Application.WorksheetFunction.Max(RF, RV)

                   .PageSetup.Orientation = xlLandscape
                   .PageSetup.Zoom = False
                   .PageSetup.FitToPagesTall = False
                   .PageSetup.FitToPagesWide = 1
                   .PageSetup.PrintArea = "$A$1:" & Cells(Rw, Col).Address
                End With
            End if

         Next wsA
    response = MsgBox(prompt:="PDF's created and saved", Buttons:=vbOKOnly, Title:="Exported to PDF and saved in new folder")