Import Multiple files in separate sheets using FileDialog

Question

Hi,

I want to import multiple files in separate worksheets using dialogbox. I am a complete newbie to VBA and would appreciate your help in getting me started.

Answer 1

Move the Set wkbAll = ActiveWorkbook to a position before x = 1

If you want to process all of the files in a folder, use:

Sub CombineTextFiles()

Dim FilesToOpen

Dim x As Integer

Dim wkbAll As Workbook

Dim wkbTemp As Workbook

Dim sDelimiter As String

Dim fd as FileDialog

Dim strFolder as String

On Error GoTo ErrHandler

Application.ScreenUpdating = False

sDelimiter = "|"

Set fd = Application.FileDialog(msoFileDialogFolderPicker)

With fd

    .title = "Select the folder that contains the files that you want to save with a thumbnail."

    If .Show = -1 Then

        strFolder = .SelectedItems(1) & ""

    Else

        MsgBox "You did not select a folder."

        GoTo ExitHandler

    End If

End With

strfile = Dir$(strFolder & "*.csv")

Set wkbAll = ActiveWorkbook 

x = 1

While strfile <> ""

        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))

        With wkbAll

            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)

            .Worksheets(x).Columns("A:A").TextToColumns _

              Destination:=Range("A1"), DataType:=xlDelimited, _

              TextQualifier:=xlDoubleQuote, _

              ConsecutiveDelimiter:=False, _

              Tab:=False, Semicolon:=False, _

              Comma:=False, Space:=False, _

              Other:=True, OtherChar:=sDelimiter

        End With

        wkbTemp.Close SaveChanges:=False

        x = x + 1

       strfile = Dir$()

Wend

ExitHandler:

    Application.ScreenUpdating = True

    Set wkbAll = Nothing

    Set wkbTemp = Nothing

    Exit Sub

ErrHandler:

    MsgBox Err.Description

    Resume ExitHandler

End Sub

If you want to process all of the files in a folder and not just .csv files, as long as they are all the right type of file (e.g. no .doc, .pdf, etc.)  replace

strfile = Dir$(strFolder & "*.csv")

with

strfile = Dir$(strFolder & "*.*")

Answer 2

@All: Thanks for your help and advice.

I however, searched online and found an eerily similar post here.

Although it does work beautifully, the only exceptions are:

1. the use of picking up a folder instead of individual files, and
2. it would work with text files only.

Hope this helps.

Regards

asar_k

Answer 3

Thanks Doug.

I was able to find a matching solution to my query late last night. But I forgot to mention it here. Code as follows:

Sub CombineTextFiles()

    Dim FilesToOpen

    Dim x As Integer

    Dim wkbAll As Workbook

    Dim wkbTemp As Workbook

    Dim sDelimiter As String

On Error GoTo ErrHandler

    Application.ScreenUpdating = False

sDelimiter = "|"

FilesToOpen = Application.GetOpenFilename _

      (FileFilter:="Text Files (*.csv), *.csv", _

      MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then

        MsgBox "No Files were selected"

        GoTo ExitHandler

    End If

x = 1

    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))

    wkbTemp.Sheets(1).Copy

    Set wkbAll = ActiveWorkbook

    wkbTemp.Close (False)

    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _

      Destination:=Range("A1"), DataType:=xlDelimited, _

      TextQualifier:=xlDoubleQuote, _

      ConsecutiveDelimiter:=False, _

      Tab:=False, Semicolon:=False, _

      Comma:=False, Space:=False, _

      Other:=True, OtherChar:="|"

    x = x + 1

While x <= UBound(FilesToOpen)

        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))

        With wkbAll

            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)

            .Worksheets(x).Columns("A:A").TextToColumns _

              Destination:=Range("A1"), DataType:=xlDelimited, _

              TextQualifier:=xlDoubleQuote, _

              ConsecutiveDelimiter:=False, _

              Tab:=False, Semicolon:=False, _

              Comma:=False, Space:=False, _

              Other:=True, OtherChar:=sDelimiter

        End With

        x = x + 1

    Wend

ExitHandler:

    Application.ScreenUpdating = True

    Set wkbAll = Nothing

    Set wkbTemp = Nothing

    Exit Sub

ErrHandler:

    MsgBox Err.Description

    Resume ExitHandler

End Sub

Now, the only issue with the above code is that, the files are imported on a new workbook, instead of the current workbook, from where the code is run.

I tried doing the following:

Replace:

Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))

    wkbTemp.Sheets(1).Copy

    Set wkbAll = ActiveWorkbook

With this:

Set wkbAll = ActiveWorkbook

wkbTemp.Sheets(1).Copy after:= wkbAll.Sheets(.Sheets.Count)

But now I get the error "No Data selected to Parse"

I however noted that, the first workbook selected in the Dialog was copied to the current workbook.

I am sure there is a way around it. Only if you could guide me to please, I'd be grateful.

I will also try your suggestion right away. Thanks again! :)

Regards

Asar

Answer 4

Start with Doug's suggestion.  Then, one approach to accomplishing what I *think* you're after would be to:

Create a new file in Excel or open the file you want to bring these other files into (I'm assuming they're already worksheets)

Then add a bit to this section of Doug's code:

For i = 1 To .SelectedItems.Count

            Set wb = Workbooks.Open(.SelectedItems(i))

            'Do something with the file

' copy the contents of the first worksheet in the newly opened file

' add a new worksheet to the "main" file that you opened to begin with

' paste in the copied content

            wb.Close SaveChanges:=False

Next i

And finally save the main file.

If there's a possibility that there are multiple worksheets in each of these files you're importing, you'd need to add another inner loop to handle that.

Answer 5

I would think that the reason that you have not had a response is because you have not provided enough information.

However, to use a File Picker dialog that allowed the selection of multiple files, use

Dim fd as FileDialog

Dim i as Long

Dim wb as WorkBook

With fd

    .Title = "Select the Files that you want to import."

    .Filters.Add "Excel Workbooks", "*.xlsx"

    .AllowMultiSelect = True

    If .Show = -1 Then

        For i = 1 To .SelectedItems.Count

            Set wb = Workbooks.Open(.SelectedItems(i))

            'Do something with the file

            wb.Close SaveChanges:=False

        Next i

    Else

       MsgBox "You did not select any files."

       Exit Sub

    End If

End With