• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Import multiple .csv files to Excel with semi-colon delimiter

R

Rodrigues

Member
All
I'm wondering if someone could please help me.
I'm using vba code on file attached to import multiple csv files, the code does import all files however won't separate by semi colon.
All file are in the same folder.
Also, would need to clear previous data on worksheets before run the "import" code.
Thanks in advance.
Regards
R
 

Attachments

  • Book1CSV.xlsm
    15.7 KB · Views: 10
  • Line 7 MMP.txt
    658.8 KB · Views: 9
Try this

Code: 
Sub ImportCSVs()
'Import all CSV files from a folder into separate sheets

Dim fPath  As String
Dim fCSV    As String
Dim wbCSV  As Workbook
Dim wbMST  As Workbook

Set wbMST = ActiveWorkbook

'Update the path to your CSV files below. Add your-username and your-folder
'Don't remove the the final \ from the file path

fPath = "C:\Path\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fCSV = Dir(fPath & "*.csv")

    Do While Len(fCSV) > 0
        Set wbCSV = Workbooks.Open(fPath & fCSV)
        ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)
         
        fCSV = Dir
    Loop

Set wbCSV = Nothing
 
'Remove blank sheets, delete the first row from each sheet, zoom out and format as table
 
    Dim ws As Worksheet
    For Each ws In Worksheets
 
    If WorksheetFunction.CountA(ws.Cells) <> 0 Then
 
      ' ws.Rows(1).Delete
            ws.Select
            ActiveWindow.Zoom = 80
            ws.UsedRange.Select
         
            Columns("A:A").Select
            Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
                ConsecutiveDelimiter:=False, _
                Tab:=True, _
                Semicolon:=True, _
                Comma:=False, _
                Space:=False, _
                Other:=False, _
                FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
                Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), _
                Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
                Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), _
                Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1)), _
                TrailingMinusNumbers:=True
        Cells.Select
        Cells.EntireColumn.AutoFit
        Range("A1").Select
         
      End If
   
    If WorksheetFunction.CountA(ws.Cells) = 0 Then
        Application.DisplayAlerts = False
                ws.Delete
                Application.DisplayAlerts = True
        End If

    Next ws

Application.ScreenUpdating = True
End Sub

gives me

upload_2018-2-25_22-21-32.png
 
Hui
Thank you very much, just one more thing please how could I make the code to clean previous worksheets data before I ran the code.
The idea is that, have this file open and every hour run the macro, as the source data files are refreshed every hour.
Thanks again, you are a life saver.
Regards
R
 
Try this:

Code: 
Sub ImportCSVs()
'Import all CSV files from a folder into separate sheets

Dim fPath  As String
Dim fCSV    As String
Dim wbCSV  As Workbook
Dim wbMST  As Workbook

Set wbMST = ActiveWorkbook

'Update the path to your CSV files below. Add your-username and your-folder
'Don't remove the the final \ from the file path

fPath = "C:\Path\"
'Application.ScreenUpdating = False
Application.DisplayAlerts = False
fCSV = Dir(fPath & "*.csv")

'Import csv files
Do While Len(fCSV) > 0
    Set wbCSV = Workbooks.Open(fPath & fCSV)
    ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count)
   
    Columns("A:A").TextToColumns Destination:=Range("A1"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=True, _
    Semicolon:=True, _
    Comma:=False, _
    Space:=False, _
    Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), _
        Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
        Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), _
        Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1)), _
        TrailingMinusNumbers:=True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
   
    fCSV = Dir
Loop

Set wbCSV = Nothing
'Remove blank sheets, delete the first row from each sheet, zoom out and format as table

Dim ws As Worksheet
For Each ws In Worksheets
   
    'If worksheet is not blank format it
    If WorksheetFunction.CountA(ws.Cells) <> 0 Then
        ws.Select
        'ws.Cells.Delete
        ActiveWindow.Zoom = 80
        Range("A1").Select
    End If
   
    'If worksheet is blank remove it
    If WorksheetFunction.CountA(ws.Cells) = 0 Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
    End If
Next ws

Application.ScreenUpdating = True
End Sub
 
Hi Hui
Returns, run time error 1004 - No data was selected to parse and highlighted
Code: 
    Columns("A:A").TextToColumns Destination:=Range("A1"), _
    DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, _
    Tab:=True, _
    Semicolon:=True, _
    Comma:=False, _
    Space:=False, _
    Other:=False, _
        FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), _
        Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
        Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), _
        Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1)), _
        TrailingMinusNumbers:=True

Thanks again for your time and hep.
Regards
R
 
Make sure the path is correct as well as the file extension

Works when there right
upload_2018-2-26_17-21-45.png
 
Last edited:
Hui
I'm really sorry, checked the path/file extensions and are correct, the files are the same.
Could you please check files attached (have rename the csv to txt to be able to upload them).
Thanks again
Regards
 

Attachments

  • Line 7 MMP.txt
    658.8 KB · Views: 2
  • Line 8 MMP.txt
    654 KB · Views: 1
  • Line 9 MMP.txt
    664.2 KB · Views: 2
  • Import CSV 1.xlsm
    16.2 KB · Views: 2
I put all these files in one directory
I didn't change file names
I changed the path to where I put the 4 files
I changed the file extension to ".txt"
upload_2018-2-26_22-28-24.png

I ran the macro as it was in the file
upload_2018-2-26_22-27-45.png

I then changed the files names to *.csv and changed the line in the code to read ".csv" files

upload_2018-2-26_22-31-13.png

It works again

I have no idea what you are doing ?

I consider the problem solved!
.
 
You must log in or register to reply here.
Back
Top