Open multiple excel files, copy, paste, close

Question

I am attempting to fix my current code to allow multiple excel workbooks to be opened at once rather than one at a time. Currently my code runs one at a time, where I open the workbook, copy the data, paste into the macros workbook, and close the external workbook.

CURRENT CODE:

Sub Intro()
Dim fd As FileDialog
Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook   As Workbook
Dim fNameAndPath As Variant

Set wkbCrntWorkBook = ActiveWorkbook
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel 2007, *.xls; _
    *.xlsx; *.xlsm; *.xlsa", Title:="Select File To Import")
If fNameAndPath = False Then Exit Sub

Call ReadDataFromSourceFile(fNameAndPath)
End Sub



Sub ReadDataFromSourceFile(filePath As Variant)
Application.ScreenUpdating = False

Dim n As Double
Dim wksNew As Excel.Worksheet
Dim src As Workbook
Set src = Workbooks.Open(filePath, False, False)

On Error GoTo CloseIt
Dim srcRng As Range
With src.Worksheets("Sheet1")
    Set srcRng = .Range(.Range("A1"), .Range("A1").End(xlDown).End(xlToRight))
End With

With ThisWorkbook
    Set wksNew = .Worksheets.Add(After:=.Worksheets(.Sheets.Count))
    n = .Sheets.Count
    .Worksheets(n).Range("A1").Resize(srcRng.Rows.Count, srcRng.Columns.Count).Value = srcRng.Value
End With

Dim regEx As New RegExp
Dim GetNum As String
Dim strPattern As String
Dim strInput As String
Dim strReplace As String
Dim strOutput As String
Dim match As Object

strPattern = "^\d{0,9}\B|\b\d{0,9}(?=\s*\.)"

If strPattern <> "" Then
    strInput = src.Name

    With regEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = False
        .Pattern = strPattern
    End With

    If regEx.test(strInput) Then
        Set match = regEx.Execute(strInput)
        GetNum = match.Item(0)
        ThisWorkbook.Worksheets(n).Name = GetNum
    Else
        GetNum = ""
    End If
End If

src.Close False
Set src = Nothing
Exit Sub

CloseIt:
src.Close False
Set src = Nothing
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(n).Delete
Application.DisplayAlerts = True
MsgBox "ERROR!! You already entered this file"
End Sub

Moreover, this code takes the numbers from the excel file name, eg. "010117Siemens Hot - Cold Report.xls", so it grabs the date (010117) and names the new worksheet with the date.

However, I am more concerned with doing something similar to the code below to make matters easier to upload files. Which I found at this site

TEST CODE:

Sub OpenSeveralFiles()

    Dim fd As FileDialog
    Dim FileChosen As Integer
    Dim FileName As String
    Dim i As Integer
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    fd.InitialFileName = "Libraries\Documents"
    fd.InitialView = msoFileDialogViewList
    fd.AllowMultiSelect = True

    FileChosen = fd.Show
    If FileChosen = -1 Then
        For i = 1 To fd.SelectedItems.Count
            Workbooks.Open fd.SelectedItems(i)
            Call ReadDataFromSourceFile(FileChosen)
        Next i
    End If
End Sub

Private Sub ReadDataFromSourceFile(filePath As Variant)

    Application.ScreenUpdating = False

    Dim n As Double
    Dim wksNew As Excel.Worksheet
    Dim src As Workbook
    Set src = Workbooks.Open(filePath, False, False)

    On Error GoTo CloseIt
    Dim srcRng As Range
    With src.Worksheets("Sheet1")
        Set srcRng = .Range(.Range("A1"), .Range("A1").End(xlDown).End(xlToRight))
    End With

    With ThisWorkbook
        Set wksNew = .Worksheets.Add(After:=.Worksheets(.Sheets.Count))
        n = .Sheets.Count
        .Worksheets(n).Range("A1").Resize(srcRng.Rows.Count, srcRng.Columns.Count).Value = srcRng.Value
End With

    Dim regEx As New RegExp
    Dim GetNum As String
    Dim strPattern As String
    Dim strInput As String
    Dim strReplace As String
    Dim strOutput As String
    Dim match As Object

    strPattern = "^\d{0,9}\B|\b\d{0,9}(?=\s*\.)"

    If strPattern <> "" Then
        strInput = src.Name

        With regEx
            .Global = True
            .MultiLine = True
            .IgnoreCase = False
            .Pattern = strPattern
        End With

        If regEx.test(strInput) Then
            Set match = regEx.Execute(strInput)
            GetNum = match.Item(0)
            ThisWorkbook.Worksheets(n).Name = GetNum
        Else
            GetNum = ""
        End If
    End If

    src.Close False
    Set src = Nothing
Exit Sub

CloseIt:
    src.Close False
    Set src = Nothing
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets(n).Delete
    Application.DisplayAlerts = True
    MsgBox "ERROR!! You already entered this file"
End Sub

In all, I am curious if there is a way to combine these methods and create a sub that opens external excel workbooks, copies the data, pastes that into a new worksheet in the macros workbook, and then close the external workbook. Thanks in advance

I edited my current to what I have been working on to try and fix the issue, but I am running into an issue with Dim regEx As New RegExp. As it is undefined?

Well yes, in both you are referencing a workbook so that should be your starter for ten. — SJR
@sjr - I'm a bit confused by your comment.. I know that one is utilizing a variant while the other is using Filedialogs. — A Cohen
@user2731076 - I want to be able to select multiple files at once rather than one at a time. And each time it opens a file, I want it to loop through the rest of my code, close the first file, and then move on to the next file — A Cohen
@Wookies-Will-Code - I will not be the only person using this. Can I just do a dialog box where the user clicks on the folder he/she wants to process — A Cohen
@user2731076 - I edited my original post with what I am attempting to do — A Cohen

user2731076 user2731076 · Accepted Answer · 2018-01-19T19:43:30

In order to open multiple files at once, loop through and perform code on each one, and then close it, try something as OUTLINED below:

Sub OpenSeveralFiles()

Dim fd As FileDialog
Dim FileChosen As Integer
Dim FileName As String
Dim tempWB As Workbook
Dim i As Integer

Set fd = Application.FileDialog(msoFileDialogFilePicker)

fd.InitialFileName = "Libraries\Documents"
fd.InitialView = msoFileDialogViewList
fd.AllowMultiSelect = True

FileChosen = fd.Show
If FileChosen = -1 Then
    For i = 1 To fd.SelectedItems.Count
        Set tempWB = Workbooks.Open(fd.SelectedItems(i))
        Call ReadDataFromSourceFile(tempWB)
    Next i
End If
End Sub

Private Sub ReadDataFromSourceFile(src As Workbook)

Application.ScreenUpdating = False

' do your stuff   

End Sub

This should be a start to answer your original question of opening multiple files at once and performing some operation on each. The way you currently try tries to open each file twice but I don't think you are actually passing a string to the ReadDataFromSourceFile sub. This way you pass a reference to the workbook so just remove where you open the file and define src and it should work. Your RegExp trouble seems to me like a separate problem/question.

Open multiple excel files, copy, paste, close

1 Answers