将VBA从选择对话框更改为活动文件夹

我们使用下面的代码来提取所有选定的工作簿。并将它们合并为一张工作簿中的工作表,然后将所有工作表合并为一个列表。

工作正常。

但是,我希望它采用活动文件夹中所有以“ packaginglist.xlsx”(通配符为)结尾的文件。如果没有该对话框可以节省一些时间和潜在的错误。

Sub Konsolider_pakkeliste()
    'Merges all files in a folder to a main file.

    'Define variables:
    Dim numberOfFilesChosen,i As Integer
    Dim tempFileDialog As FileDialog
    Dim mainWorkbook,sourceWorkbook As Workbook
    Dim tempWorkSheet As Worksheet
    Dim xTCount As Variant
    Dim xWs As Worksheet
    On Error Resume Next


    Workbooks.Add
    ChDir "C:\XML_Pakkelister\" & Range("C6")
    activeWorkbook.SaveAs FileName:= _
        "C:\XML_Pakkelister\" & Range("C6") & "\" & Range("C4") & " Consolidated packaginglist.xlsx" _,FileFormat:=xlOpenXMLWorkbook,CreateBackup:=False

    '*******************************************************************************************
    Set mainWorkbook = Application.activeWorkbook
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

    'Allow the user to select multiple workbooks
    tempFileDialog.AllowMultiSelect = True

    numberOfFilesChosen = tempFileDialog.Show

    'Loop through all selected workbooks
    For i = 1 To tempFileDialog.SelectedItems.count

        'Open each workbook
        Workbooks.Open tempFileDialog.SelectedItems(i)

        Set sourceWorkbook = activeWorkbook

        'Copy each worksheet to the end of the main workbook
        For Each tempWorkSheet In sourceWorkbook.Worksheets
            tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.count)
        Next tempWorkSheet

        'Close the source workbook
        sourceWorkbook.Close
    Next i
    '*******************************************************************************************
    'UpdateByKutools20151029
    'Combine the sheets

LInput:
    xTCount = 1
    Set xWs = activeWorkbook.Worksheets.Add(Sheets(1))
    xWs.Name = "Combined"
    Worksheets(2).Range("A17").EntireRow.Copy Destination:=xWs.Range("A17")
    For i = 2 To Worksheets.count
        Worksheets(i).Range("A17").CurrentRegion.Offset(CInt(xTCount),0).Copy _
               Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.count).Row,1)

    Next

End Sub
l13952781422 回答:将VBA从选择对话框更改为活动文件夹

暂时没有好的解决方案,如果你有好的解决方案,请发邮件至:iooj@foxmail.com
本文链接:https://www.f2er.com/3157704.html

大家都在问