excel 尝试让我的VBA脚本从数组导出特定工作表到csv，但在第三个工作表上继续获得运行时间1004

hrysbysz 于 2022-12-24 发布在其他

关注(0)|答案(1)|浏览(107)

我一直在我的代码工作，让系统导出特定的工作表只根据什么是在系统中可见的，但由于某种原因，我继续斗争，当它试图运行导出只得到指定的工作表导出。我知道这必须是一些简单的，我错过了，但我无法找到可能是什么。任何帮助将不胜感激。

Private Sub ExportSheets()       'saves all visible sheets as new xlsx files
    Dim ws As Worksheet, wbNew As Workbook
    Dim myWorksheets() As String 'Array to hold worksheet names to copy
    Dim sFolderPath As String
    Dim fs As Object
    Dim FileName1 As String
    Dim i As Integer

    Set wbNew = Application.ThisWorkbook
    FileName1 = Range("PMC_Name").Value
    sFolderPath = wbNew.Path & "\" & FileName1 & " - Import Templates"
    myWorksheets = Split("Chart of Accounts, Custom Mapping File, Custom Chart of Accounts,Conventional Default COA,Conventional Mapping File,CONV Chart of Accounts,HUD Chart of Accounts,Affordable Default COA,Affordable Mapping File,Entities,Properties,Floors,Units,Area Measurement,Tenants,Account Labels,Leases,Scheduled Charges,Tenant Beginning Balances,Vendors,Vendor Beginning Balances,Customers,Customer Beginning Balances,GL Beginning Balances,GL Detail,Bank Accounts,Budgets,Budgeting COA,Budgeting Conventional COA,Budgeting Affordable COA,Budgeting Job Positions,Budgeting Employee List,Budgeting Workers Comp,Expense Pools,Lease Recoveries,Index Code,Lease Sales,Option Types,Clause Types,Lease Clauses,Lease Options,Budgeting Current Budget Import,Job Cost,Draw Model Detail,Job Cost History,Job Cost Budgets,Fixed Assets,Condo Properties,Owners,Ownership Information,Ownership Billing,Owner Charges", ",") 'this contains an array of the sheets. You need to put the real sheet names here.
    
    If Dir(sFolderPath, vbDirectory) <> "" Then
        'If the folder does exist error
        MsgBox "The folder currently exists, please rename or delete the folder.", vbCritical, "Error"
    
        Exit Sub
        'If the folder does not exist create folder and export
    End If
    
    MkDir sFolderPath
    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Sheets                      'for each worksheet
        'if it's visible:
        If Sheets(myWorksheets(i)).visible Then
            Debug.Print "Exporting: " & ws.Name
            ws.Copy '(if no params specified, COPY creates + activates a new wb)
            Set wbNew = Application.ActiveWorkbook          'get new wb object
            wbNew.SaveAs sFolderPath & "\" & ws.Name & ".csv", 23 'save new wb
            wbNew.Close                                     'close new wb
            Set wbNew = Nothing                             'cleanup
        End If
    Next ws
    Set ws = Nothing                                        'clean up
    Application.ScreenUpdating = False
    
    MsgBox "Sheet Export is now Complete. You can find the files at the following path." & vbNewLine & vbNewLine & sFolderPath, vbExclamation, "Export Sheets Complete"
End Sub

excel

来源：https://stackoverflow.com/questions/74868147/trying-to-get-my-vba-script-to-export-specific-sheets-to-csv-from-an-array-but-c

1条答案

按热度按时间

xzlaal3s1#

导出图纸

Sub ExportSheets()       'saves all visible sheets as new xlsx files
    
    Const PROC_TITLE As String = "Export Sheets"
    Const SHEET_LIST As String _
        = "Chart of Accounts,Custom Mapping File,Custom Chart of Accounts," _
        & "Conventional Default COA,Conventional Mapping File," _
        & "CONV Chart of Accounts,HUD Chart of Accounts," _
        & "Affordable Default COA,Affordable Mapping File,Entities," _
        & "Properties,Floors,Units,Area Measurement,Tenants,Account Labels," _
        & "Leases,Scheduled Charges,Tenant Beginning Balances,Vendors," _
        & "Vendor Beginning Balances,Customers,Customer Beginning Balances," _
        & "GL Beginning Balances,GL Detail,Bank Accounts,Budgets," _
        & "Budgeting COA,Budgeting Conventional COA,Budgeting Affordable COA," _
        & "Budgeting Job Positions,Budgeting Employee List," _
        & "Budgeting Workers Comp,Expense Pools,Lease Recoveries,Index Code," _
        & "Lease Sales,Option Types,Clause Types,Lease Clauses,Lease Options," _
        & "Budgeting Current Budget Import,Job Cost,Draw Model Detail," _
        & "Job Cost History,Job Cost Budgets,Fixed Assets,Condo Properties," _
        & "Owners,Ownership Information,Ownership Billing,Owner Charges"
    
    Dim swb As Workbook: Set swb = ThisWorkbook
    Dim sws As Worksheet: Set sws = swb.Sheets("Sheet1") ' adjust!
    
    Dim PMC As String: PMC = CStr(sws.Range("PMC_Name").Value)
    Dim dFolderPath As String
    dFolderPath = swb.Path & "\" & PMC & " - Import Templates\"
    
    If Len(Dir(dFolderPath, vbDirectory)) > 0 Then
        MsgBox "The folder already exists. " _
            & "Please rename or delete the folder.", vbCritical, PROC_TITLE
        Exit Sub
    End If
    
    MkDir dFolderPath
    
    Dim SheetNames() As String: SheetNames = Split(SHEET_LIST, ",")
    
    Application.ScreenUpdating = False
           
    Dim dwb As Workbook, ssh As Object, SheetName
    
    For Each SheetName In SheetNames
        On Error Resume Next
            Set ssh = swb.Sheets(SheetName)
        On Error GoTo 0
        If Not ssh Is Nothing Then ' sheet exists
            If ssh.Visible Then ' sheet is visible
                Debug.Print "Exporting: " & ssh.Name
                ssh.Copy ' creates a single-sheet workbook
                Set dwb = Workbooks(Workbooks.Count)
                dwb.SaveAs dFolderPath & ssh.Name & ".csv", xlCSVWindows ' 23
                dwb.Close SaveChanges:=False
            'Else ' sheet is not visible; do nothing
            End If
            Set ssh = Nothing ' reset for the next iteration
        'Else ' sheet doesn't exist; do nothing
        End If
    Next SheetName
    
    Application.ScreenUpdating = True
    
    MsgBox "Sheet Export is now complete. " _
        & "You can find the files in the following path:" & vbLf & vbLf _
        & dFolderPath, vbInformation, PROC_TITLE

End Sub

赞(0）回复(0）举报 2022-12-24

我来回答

excel 尝试让我的VBA脚本从数组导出特定工作表到csv，但在第三个工作表上继续获得运行时间1004

1条答案

导出图纸

相关问题

热门标签

最新问答