• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 297
  • Last Modified:

Import multiple CSV files into specific worksheets

Hello Experts,

Looking to import a number of CSV files into a single workbook, into individual and specific worksheets.

These CSV files will be located in a directory, say c:\user. In total, there are 8 csv files to be imported, in comma delimited format.

However, as there are 8 different files, each csv file is required to be imported into a pre-named worksheet within the workbook.

For example a csv file that CONTAINS the phrase "area 1", will be imported into the worksheet with the name "area 1".
Similarly, csv file that CONTAINS the phrase "area 2", will be imported into the worksheet with the name "area 2".......so on until "area 8".

Regards

LK
0
lkirke
Asked:
lkirke
  • 10
  • 8
1 Solution
 
SiddharthRoutCommented:
>>>For example a csv file that CONTAINS the phrase "area 1"

Where is this phrase? In the File Name or the File Contents?

Sid
0
 
lkirkeAuthor Commented:
Apologies Sid. It is in the filename.
0
 
SiddharthRoutCommented:
TRIED AND TESTED

Ok Try this Sample File which is attached.

The Sheets are already created in it. All you need to do is run the macro Sample in the Module.

Please change path of the Folder in the code below before running it :)

Hope this helps.

Sid

Code Used

Option Explicit

Dim MYFileArray() As String
Dim j As Long

Sub Sample()
    Dim i As Long, LastRow As Long, r As Long, k As Long
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim StrSheetName As String
    
    On Error GoTo Whoa
    
    Set wb1 = ActiveWorkbook
    
    '~~> Change the path of the folder here
    ListFiles "C:\MyFolder", "*.csv"
    
    For k = 1 To UBound(MYFileArray)
        StrSheetName = Replace(GetFilenameFromPath(MYFileArray(k)), ".csv", "", , , vbTextCompare)
        
        Set ws1 = wb1.Sheets(StrSheetName)
        
        Set wb2 = Workbooks.Open(MYFileArray(k))
        Set ws2 = wb2.Sheets(1)
        
        r = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
        
        ws2.UsedRange.Copy ws1.Range("A" & r)
        wb2.Close savechanges:=False
    Next k
LetsContinue:
    On Error Resume Next
    Set ws2 = Nothing
    Set wb2 = Nothing
    On Error GoTo 0
    
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Public Function ListFiles(FolderPath As String, Extension As String)
    Dim FolderName As String
    Dim DirNames() As String
    Dim SubDirectories As Long
    Dim i As Long

    '~~> List files in the main/first folder
    On Error Resume Next
    FolderName = Dir(FolderPath & "\" & Extension, vbNormal)
    On Error GoTo 0
    
    Do While FolderName <> vbNullString
        j = j + 1
        ReDim Preserve MYFileArray(j)
        MYFileArray(j) = FolderPath & "\" & FolderName
        FolderName = Dir()
    Loop
    
    '~~> Get the sub directories
    On Error Resume Next
    FolderName = Dir(FolderPath & "\*.*", vbDirectory)
    On Error GoTo 0

    Do While FolderName <> vbNullString
        If FolderName <> "." And FolderName <> ".." Then
            SubDirectories = SubDirectories + 1
            ReDim Preserve DirNames(1 To SubDirectories)
            DirNames(SubDirectories) = FolderName
        End If
        FolderName = Dir()
    Loop

    For i = 1 To SubDirectories
        ListFiles FolderPath & "\" & DirNames(i), Extension
    Next i
End Function

Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

Open in new window

Area-Sample.xls
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
lkirkeAuthor Commented:
Excellent Sid. Just looking through the code.

Noticed there is no "area 1" phrase to lookup for the csv or the workbook. How does it do the match?
0
 
SiddharthRoutCommented:
Line 22 takes care of that :)

Sid
0
 
SiddharthRoutCommented:
Just ensure that there are no csvs in the folder other than Area1-8

Sid
0
 
lkirkeAuthor Commented:
Understood Sid. Was hoping to kill two birds with one stone. Another spreadsheet will have 8 csv's, but this time the filenames will contain "CAN_CON", "CAN DPC C1", "CAN DPC C2". Would this cause a problem?
0
 
SiddharthRoutCommented:
>>Would this cause a problem?

Yes. Here is a workaround.

Create a new folder and paste the CAN_ csv there. And simply change the sheetname to match the file names. That's it. And yes, just change the folder name in the code. The code will work fine :)

BTW Did you test the above code that I gave?

Sid
0
 
lkirkeAuthor Commented:
Great Sid. Testing now. :)
0
 
lkirkeAuthor Commented:
Attempted to run Sid. Returns with the message  "subscript out of range"
0
 
SiddharthRoutCommented:
Check the names of the csv. They have to be in this order

"Area 1.CSV"
"Area 2.CSV"
"Area 3.CSV"
"Area 4.CSV"
"Area 5.CSV"
"Area 6.CSV"
"Area 7.CSV"
"Area 8.CSV"

No Extra spaces in between or before or after.

Sid
0
 
lkirkeAuthor Commented:
Bingo. That is where the problem is. The files received contain the phrase "area 1". For example:

CSV 2011-01-01 2011-01-31 Area 1 20110420 121613.csv

As these are monthly files, the names will always change. However, Area 1 will always be a constant within the filename.

0
 
SiddharthRoutCommented:
Ok Got it. Gimme few moments. I'll amend the code.

Sid
0
 
SiddharthRoutCommented:
Ok Please try this

Sid
Area-Sample.xls
0
 
lkirkeAuthor Commented:
Perfect. Your a god. :)
0
 
SiddharthRoutCommented:
Glad to be of help :)

Sid
0
 
lkirkeAuthor Commented:
Sid, all works as you suggested. Now, if possible, I am trying to increase my understanding of what each component does within the code. For example, what do the following functions do:

Function GetFilenameFromPath(ByVal strPath As String) As String
Public Function ListFiles(FolderPath As String, Extension As String)

Also, what does this section do within the Sub Sample() code:

 Set wb2 = Workbooks.Open(MYFileArray(k))
        Set ws2 = wb2.Sheets(1)
       
        r = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
       
        ws2.UsedRange.Copy ws1.Range("A" & r)
        wb2.Close savechanges:=False

Regards

LK
Option Explicit

Dim MYFileArray() As String
Dim j As Long

Sub Sample()
    Dim i As Long, LastRow As Long, r As Long, k As Long
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim StrSheetName As String
    
    On Error GoTo Whoa
    
    Set wb1 = ActiveWorkbook
    
    '~~> Change the path of the folder here
    ListFiles "C:\MyFolder", "*.csv"
    
    For k = 1 To UBound(MYFileArray)
        StrSheetName = Replace(GetFilenameFromPath(MYFileArray(k)), ".csv", "", , , vbTextCompare)
        
        If InStr(1, StrSheetName, "Area 1", vbTextCompare) Then
            Set ws1 = wb1.Sheets("Area 1")
        ElseIf InStr(1, StrSheetName, "Area 2", vbTextCompare) Then
            Set ws1 = wb1.Sheets("Area 2")
        ElseIf InStr(1, StrSheetName, "Area 3", vbTextCompare) Then
            Set ws1 = wb1.Sheets("Area 3")
        ElseIf InStr(1, StrSheetName, "Area 4", vbTextCompare) Then
            Set ws1 = wb1.Sheets("Area 4")
        ElseIf InStr(1, StrSheetName, "Area 5", vbTextCompare) Then
            Set ws1 = wb1.Sheets("Area 5")
        ElseIf InStr(1, StrSheetName, "Area 6", vbTextCompare) Then
            Set ws1 = wb1.Sheets("Area 6")
        ElseIf InStr(1, StrSheetName, "Area 7", vbTextCompare) Then
            Set ws1 = wb1.Sheets("Area 7")
        ElseIf InStr(1, StrSheetName, "Area 8", vbTextCompare) Then
            Set ws1 = wb1.Sheets("Area 8")
        Else
            GoTo NextFile
        End If
        
        Set wb2 = Workbooks.Open(MYFileArray(k))
        Set ws2 = wb2.Sheets(1)
        
        r = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
        
        ws2.UsedRange.Copy ws1.Range("A" & r)
        wb2.Close savechanges:=False
NextFile:
    Next k
LetsContinue:
    On Error Resume Next
    Set ws2 = Nothing
    Set wb2 = Nothing
    On Error GoTo 0
    
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Public Function ListFiles(FolderPath As String, Extension As String)
    Dim FolderName As String
    Dim DirNames() As String
    Dim SubDirectories As Long
    Dim i As Long

    '~~> List files in the main/first folder
    On Error Resume Next
    FolderName = Dir(FolderPath & "\" & Extension, vbNormal)
    On Error GoTo 0
    
    Do While FolderName <> vbNullString
        j = j + 1
        ReDim Preserve MYFileArray(j)
        MYFileArray(j) = FolderPath & "\" & FolderName
        FolderName = Dir()
    Loop
    
    '~~> Get the sub directories
    On Error Resume Next
    FolderName = Dir(FolderPath & "\*.*", vbDirectory)
    On Error GoTo 0

    Do While FolderName <> vbNullString
        If FolderName <> "." And FolderName <> ".." Then
            SubDirectories = SubDirectories + 1
            ReDim Preserve DirNames(1 To SubDirectories)
            DirNames(SubDirectories) = FolderName
        End If
        FolderName = Dir()
    Loop

    For i = 1 To SubDirectories
        ListFiles FolderPath & "\" & DirNames(i), Extension
    Next i
End Function

Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

Open in new window

0
 
SiddharthRoutCommented:
>>>Function GetFilenameFromPath(ByVal strPath As String) As String

This gets you the file name from the path. For example

GetFilenameFromPath("C:\Temp\MyFile.xls") will give you "MyFile.xls"

>>>>Public Function ListFiles(FolderPath As String, Extension As String)

ListFiles gets the name of all the files from the current folder and subfolder matching a particular extension into an array (MYFileArray) so that we can loop through the file names and perform the relevant action.

>>>>Also, what does this section do within the Sub Sample() code:
 Set wb2 = Workbooks.Open(MYFileArray(k))

This is where I am looping through my array and opening the files like I mentioned above :)

HTH

Sid
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 10
  • 8
Tackle projects and never again get stuck behind a technical roadblock.
Join Now