Excel VBA importing multiple csv files from a folder

[biologyMajor]

Hi all,

I'm very new to excel macros and VBA, but I am trying to write a macro capable of importing all .csv files from a folder into separate worksheets of a workbook. I wrote a macro for ImageJ that is able to produce a .csv data file for each image processed (these have a fixed number of columns, but variable number of rows). With hundreds of images worth of data to analyze I thought developing a macro capable of performing data analysis would be the most appropriate course of action.

To begin with, I recorded the import of a .csv file to find the start point for my code, but after adding a folder select and trying to remove the file specification I get "Run-time error '1004': Application-defined or object-defined error" on the line
.Refresh BackgroundQuery:=False

I've tried changing it to True with no effect, and commenting out the line results in a loop of sheet additions. So far I've had no luck in searching for alternatives to Query Tables and am at a complete loss as to what is causing it to fail. Any help with coding or pointers would be greatly appreciated!

Option Explicit
Sub ImportCSVData()


Dim wb As Workbook
Dim wbCSV As Workbook
Dim myPath As String
Dim myFile As Variant
Dim fileType As String
Dim i As Integer


'Get Target Folder Path From User
 With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Source Folder"
        .AllowMultiSelect = False
        .Show
        myPath = .SelectedItems(1)
    End With


'Specify file type
  fileType = "*.csv*"


'Target Path with file type
  myFile = Dir(myPath & fileType)


'Add Target Workbook
 Workbooks.Add
 ActiveWorkbook.SaveAs Filename:= _
        myPath & " Total Results.xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False


Set wb = Workbooks.Open(myPath & " Total Results.xlsm")


'Loop through each Excel file in folder
  Do While myFile > 0
    Worksheets.Add(Before:=Worksheets("Sheet1")).Name = "Image " & i + 1
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myPath & "*.csv" _
            , Destination:=ActiveSheet.Range("$A$1"))
            .Name = myFile
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False    'Error occurs here!
        End With
    i = i + 1
  Loop


'Message Box when tasks are completed
  MsgBox "Result Import Complete"


End Sub

I'm running Excel 2010 on Windows 7.

Thanks in advance!

 

[PatOBrien198]

First thing that I noticed is you might be missing a statement that updates the name of the csv file you are loading.... perhaps when you increment i you need to update the file name...

      i = i + 1
      MyFile = Dir
  Loop

 

[PatOBrien198]

Sub ImportCSVData()

Dim wb As Workbook
Dim wbCSV As Workbook
Dim myPath As String
Dim myFile As Variant
Dim fileType As String
Dim i As Integer

'Get Target Folder Path From User
 With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Source Folder"
        .AllowMultiSelect = False
        .Show
'  changed the following line - added the backslash to the path
        myPath = .SelectedItems(1) & "\"
    End With

'Specify file type
  fileType = "*.csv*"

'Target Path with file type
  myFile = Dir(myPath & fileType)

'Add Target Workbook
 Workbooks.Add
'  changed the following line - removed leading space in file name
 ActiveWorkbook.SaveAs Filename:= _
        myPath & "Total Results.xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'  changed the following line - removed leading space in file name
Set wb = Workbooks.Open(myPath & "Total Results.xlsm")

'Loop through each Excel file in folder
'  changed the following line - to test myFile against a null string, rather than a value of 0
  Do While myFile <> ""
    Worksheets.Add(Before:=Worksheets("Sheet1")).Name = "Image " & i + 1
'changed the following line - from *.csv to myFile ** This was probably what was causing the error
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myPath & myFile _
            , Destination:=ActiveSheet.Range("$A$1"))
            .Name = myFile
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False    'Error occurs here!
        End With
    i = i + 1
    myFile = Dir
    
  Loop

'Message Box when tasks are completed
  MsgBox "Result Import Complete"

End Sub

 

[biologyMajor]

Works perfectly! Thank you so much for your help

 

[missclumsy]

I have 92 different csv files with the name of code_2014.csv, this code makes the differentiation between those. Every of those csv files have 4 columns. I want to take 3rd column from every of those csv file and placing in new excel file one by another with the code above it. Is this possible?
I will appreciate any answer!

 

[John_w]

I have 92 different csv files with the name of code_2014.csv, this code makes the differentiation between those. Every of those csv files have 4 columns. I want to take 3rd column from every of those csv file and placing in new excel file one by another with the code above it. Is this possible?
I will appreciate any answer!

Welcome to MrExcel. Since your request is different to this thread, though related, please start a new thread, linking to this one if you think it would help.

In your new thread please give more details.

I think I understand the .csv input files and how you want them to be imported. But what should the final Excel output file look like? Should column 3 of each csv file be imported into a separate column, A, B, C, etc? For example, column A contains the data from the first csv file, with A1 containing the code from the file name, and A2 the first data value; similarly column B contains the data from the second csv file. Or should all csv files be imported into one column? Or another arrangement?

 

[bmwbykrydr]

Sub ImportCSVData()

Dim wb As Workbook
Dim wbCSV As Workbook
Dim myPath As String
Dim myFile As Variant
Dim fileType As String
Dim i As Integer

'Get Target Folder Path From User
With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Source Folder"
        .AllowMultiSelect = False
        .Show
'  changed the following line - added the backslash to the path
        myPath = .SelectedItems(1) & "\"
    End With

'Specify file type
  fileType = "*.csv*"

'Target Path with file type
  myFile = Dir(myPath & fileType)

'Add Target Workbook
Workbooks.Add
'  changed the following line - removed leading space in file name
ActiveWorkbook.SaveAs Filename:= _
        myPath & "Total Results.xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'  changed the following line - removed leading space in file name
Set wb = Workbooks.Open(myPath & "Total Results.xlsm")

'Loop through each Excel file in folder
'  changed the following line - to test myFile against a null string, rather than a value of 0
  Do While myFile <> ""
    Worksheets.Add(Before:=Worksheets("Sheet1")).Name = "Image " & i + 1
'changed the following line - from *.csv to myFile ** This was probably what was causing the error
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myPath & myFile _
            , Destination:=ActiveSheet.Range("$A$1"))
            .Name = myFile
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False    'Error occurs here!
        End With
    i = i + 1
    myFile = Dir
   
  Loop

'Message Box when tasks are completed
  MsgBox "Result Import Complete"

End Sub

Can you help me figure this out, please? I have 274 CSV files that I need in a single worksheet. I'm working on modifying this macro to do basically the same thing, just import the CSV contents of several files into a new worksheet in the current workbook. I'm not having much luck. This is something that I may need to do on a monthly basis so I like that it asks where the file are, just need the import to appear in the workbook that I start the macro from.

 

[bmwbykrydr]

I have gone through 6 or 7 of the other posts that are very similar to this request. I'm just not familiar enough with VBA to pick and choose the portions of the different macros they contain to get the functionality merged into one macro.

 

[John_w]

Can you help me figure this out, please? I have 274 CSV files that I need in a single worksheet.

Welcome to MrExcel forums. Please start a new thread for your request, linking to this one if you think it would help as a starting point for your macro.

 

[bmwbykrydr]

I stumbled my way through it and reverse engineered it to get what I need it to do.

Sub ImportCSVData()

Dim wb As Workbook
Dim wbCSV As Workbook
Dim myPath As String
Dim myFile As Variant
Dim fileType As String
Dim i As Integer, D As Integer

'Get Target Folder Path From User

  MsgBox "Navigate to the folder that contains the CSV files"

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select Source Folder"
.AllowMultiSelect = False
.Show
myPath = .SelectedItems(1) & "\"
    End With

'Specify file type

  fileType = "*.csv*"

'Target Path with file type

  myFile = Dir(myPath & fileType)

'Add Target Worksheet

    Worksheets("301").Activate
    ActiveSheet.Range("A1").Select

'Loop through each Excel file in folder

  Do While myFile <> ""
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myPath & myFile, Destination:=ActiveCell)
.Name = myFile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

If D = 0 Then GoTo Skip 'controls whether or not to delete the header row after paste.
ActiveCell.Rows("1:1").EntireRow.Select
                Selection.Delete Shift:=xlUp

Skip:
                D = 1

    i = i + 1
myFile = Dir

Selection.End(xlDown).Select
If ActiveCell = Range("A1048576") Then GoTo Done:
ActiveCell.Offset(1, 0).Range("A1").Select

  Loop

Done:
Range("A1").Select
  MsgBox "Import Complete"

End Sub