Загрузка нескольких книг в excel 2010

Question

Как вы можете видеть из кода, я пытаюсь загрузить одну книгу в excel. Есть ли способ выбрать несколько книг и загрузить их за один раз вместо повторного открытия диалога с файлом снова и снова?

Private Sub OpenFileDialogue() 
strCancel = "N" 
strWorkbookNameAndPath = Application.GetOpenFilename _ 
    (FileFilter:=strFilt, _ 
    FilterIndex:=intFilterIndex, _ 
    Title:=strDialogueFileTitle) 
Workbooks.Open strWorkbookNameAndPath 
End Sub 


Public strDialogueFileTitle As String 
Public strFilt As String 
Public intFilterIndex As Integer 
Public strCancel As String 
Public strWorkbookNameAndPath As String 
Public strWorkbookName As String 
Public strWorksheetName As String 

Public Sub CommandButton1_Click() 
Dim wkbMasterWorkbook As Workbook 
Dim wksMasterWorksheet As Worksheet 
Dim wkbImportedWorkbook As Workbook 
Dim wksImportedWorksheet As Worksheet 
Dim rngImportCopyRange As Range 

Application.ScreenUpdating = False 
Set wkbMasterWorkbook = ThisWorkbook 
Set wksMasterWorksheet = Sheets("Sheet1") 


strFilt = "Excel Files (*.xls),*.xls," & _ 
      "CSV Files (*.csv),*.csv," 

intFilterIndex = 1 
strDialogueFileTitle = "Select The Workbook You Want To Import" 

Call OpenFileDialogue 

If strCancel = "Y" Then 
    MsgBox ("An Open Error Occurred Importing Your File Selection") 
    Exit Sub 
End If 

Set wkbImportedWorkbook = ActiveWorkbook 
Set wksImportedWorksheet = wkbImportedWorkbook.Sheets("Sheet1") 

Set rngImportCopyRange = Range(wksImportedWorksheet.Cells(1, 1), Cells(250, 1)).EntireRow 
rngImportCopyRange.Copy 
wksMasterWorksheet.Range("A" & Rows.Count).End(xlUp).Offset(0, 0).PasteSpecial Paste:=xlPasteValues, SkipBlanks _ 
    :=False, Transpose:=False 
wkbMasterWorkbook.Activate 
Application.DisplayAlerts = False 
wkbImportedWorkbook.Close Savechanges:=False 
Application.DisplayAlerts = True 

wksMasterWorksheet.Activate 
wksMasterWorksheet.Cells(1, 1).Select 

Application.ScreenUpdating = True 
Worksheets("Sheet1").Visible = True 

End Sub 

Answer 1

попробовать это:

Private Sub OpenFileDialogue() 
Dim strWorkbookNameAndPath 
Dim fileArraySize, i as Long 

strCancel = "N" 
strWorkbookNameAndPath = Application.GetOpenFilename _ 
(FileFilter:=strFilt, _ 
FilterIndex:=intFilterIndex, _ 
Title:=strDialogueFileTitle, _ 
MultiSelect:=True)'add this line which will let you select all the files 

'your variable now contains array of filenames 
fileArraySize = Ubound(strWorkbookNameAndPath, 1) 'count how many files 

'loop and open the files 
For i = 1 to fileArraySize 
    Workbooks.Open strWorkbookNameAndPath(i) 
Next i 

edit1:

Option Explicit 
Public strDialogueFileTitle As String 
Public strFilt As String 
Public intFilterIndex As Integer 
Public strCancel As String 
Public strWorkbookNameAndPath As String 
Public strWorkbookName As String 
Public strWorksheetName As String 

Public Sub CommandButton1_Click() 

Dim wkbMasterWorkbook As Workbook 
Dim wksMasterWorksheet As Worksheet 
Dim wkbImportedWorkbook As Workbook 
Dim wksImportedWorksheet As Worksheet 
Dim rngImportCopyRange As Range 

'added this to enhance performance and eliminate alert when you close an opened file. 
With Application 
    .ScreenUpdating = False 
    .DisplayAlerts = False 
End With 

On Error Goto errhandler 'added this just in case something came up so you won't be stuck 

Set wkbMasterWorkbook = ThisWorkbook 
Set wksMasterWorksheet = wkbMasterWorkbook.Sheets("Sheet1") 

strFilt = "Excel Files (*.xls),*.xls," & _ 
     "CSV Files (*.csv),*.csv," 
intFilterIndex = 1 
strDialogueFileTitle = "Select The Workbook You Want To Import" 
strCancel = "N" 

If strCancel = "N" Then 

Dim strWorkbookNameAndPath 
Dim fileArraySize, lrow, i As Long 

strCancel = "N" 
strWorkbookNameAndPath = Application.GetOpenFilename _ 
    (FileFilter:=strFilt, _ 
    FilterIndex:=intFilterIndex, _ 
    Title:=strDialogueFileTitle, _ 
    MultiSelect:=True) 'add this line which will let you select all the files 
'your variable now contains array of filenames 
fileArraySize = UBound(strWorkbookNameAndPath, 1) 'count how many files 
'loop and open the files 
For i = 1 To fileArraySize 
    'open the file 
    Set wkbImportedWorkbook = Workbooks.Open(strWorkbookNameAndPath(i)) 
    Set wksImportedWorksheet = wkbImportedWorkbook.Sheets("Sheets1") 
    'copy all contents and paste on masterfile 
    With wksImportedWorksheet 
     lrow = .Range("A" & .Rows.Count).End(xlUp).Row 
     Set rngImportCopyRange = .Range("A1:A" & lrow).EntireRow 
     rngImportCopyRange.Copy 
     wksMasterWorksheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues 
    End With 
    'close the source file 
    wkbImportedWorkbook.Close 
    Set wkbImportedWorkbook = Nothing 
    Set wksImportedWorksheet = Nothing 
Next i 
Else 
    MsgBox "An Open Error Occurred Importing Your File Selection" 
    Exit Sub 
End If 

With Application 
    .ScreenUpdating = True 
    .DisplayAlerts = True 
End With 

Exit Sub 
errhandler: 

MsgBox "An unexpected error occurred!" & vbNewLine & _ 
    "Error No.: " & Err.Number & vbNewLine & _ 
    "Description: " & Err.Description, vbExclamation, "Error Notification" 

End Sub 

Я удалил Private Sub и заливали загрузку файла в основном коде.
Но вы всегда можете извлечь эту часть и сделать ее Private Sub, если вы собираетесь использовать ее в другом Subs.
Я тестировал это, и он отлично работает.
Если есть части кода, которые вы не понимаете, просто прокомментируйте это.