Import csv files into excel workbook

I'm looking for some help to create a macro to import 3 types of csv files into an excel workbook report template "Report_Example"

The folder where the files are generated would contain the report workbook "Report_Example"

I attached a zip file containing some example data and the report template "Report_Example"

This what I would like the macro to do:
Import the 3 different file types into a 3 seperate worksheets in report template.. like so:
- CSV file name beginning with "1F" import into worksheet "1F"
- CSV file name beginning with "2F" import into worksheet "2F"
- CSV file name beginning with "MS" import into worksheet "MS"

The files are generated daily and include the date in the name.. so when the macro is run it locates any new csv files generated and appends the data into each worksheet, ie build up a database for each csv file within the workbook

The macro may be run daily or weekly so would be good to just click on a macro button to run it.

Thanks in advance for any help
Data1.zip
ian_greigAsked:
Who is Participating?
 
redmondbConnect With a Mentor Commented:
Ian,

Darn.

Normally, when opening a CSV file, Excel is well behaved. However, doing this programatically apparently messes up the date. So, I've changed the file to use the Text Import Wizard. Couple of points...
(1) It's appreciably slower.
(2) I don't think that the code will cope with a "mm/dd/yyyy" user, so if this is identified at the start and, the run is cancelled.

I'm a "dd/mm/yyyy" use rmyslef, so I couldn't test this. Don't suppose you've any international offices who could test it?

Please see attached. The code is...
Option Explicit

Sub Daily_Run()
Dim xNext_Row_MS  As Long
Dim xNext_Row_1F  As Long
Dim xNext_Row_2F  As Long
Dim xLast_Row_CSV As Long
Dim xImported     As Long
Dim xBad          As Long
Dim xFile         As String
Dim xCSV          As Worksheet

If Day(DateSerial(2000, 1, 2)) <> 2 Then
    MsgBox ("This macro requires a System Date format of ""dd/mm/yyyy"" which this PC does not appear to have - run cancelled.")
    Exit Sub
End If

xFile = Dir(ThisWorkbook.Path & "\*.csv")
If xFile = "" Then
    MsgBox ("No CSV files found in " & ThisWorkbook.Path & "\ - run cancelled.")
    Exit Sub
End If

ThisWorkbook.Activate

xNext_Row_MS = 1 + Sheets("MS").[A1].SpecialCells(xlLastCell).Row
xNext_Row_1F = 1 + Sheets("1F").[A1].SpecialCells(xlLastCell).Row
xNext_Row_2F = 1 + Sheets("2F").[A1].SpecialCells(xlLastCell).Row

Application.ScreenUpdating = False
    
    Do
    
        Set xCSV = Workbooks(Import_CSV(xFile)).ActiveSheet
        xLast_Row_CSV = xCSV.[A1].SpecialCells(xlLastCell).Row
        
        If xLast_Row_CSV < 2 Then
            MsgBox "Warning: """ & xFile & """ has no data."
        Else
            ''''xCSV.ActiveSheet.Range("A" & xLast_Row_CSV).Interior.Color = 5296274
            With xCSV.Range("2:" & xLast_Row_CSV).EntireRow
                Select Case Mid(xFile, 1, 2)
                    Case "MS"
                        .Copy Destination:=ThisWorkbook.Sheets("MS").Range("A" & xNext_Row_MS)
                        xNext_Row_MS = xNext_Row_MS + xLast_Row_CSV - 1
                        xImported = xImported + 1
                    Case "1F"
                        .Copy Destination:=ThisWorkbook.Sheets("1F").Range("A" & xNext_Row_1F)
                        xNext_Row_1F = xNext_Row_1F + xLast_Row_CSV - 1
                        xImported = xImported + 1
                    Case "2F"
                        .Copy Destination:=ThisWorkbook.Sheets("2F").Range("A" & xNext_Row_2F)
                        xNext_Row_2F = xNext_Row_2F + xLast_Row_CSV - 1
                        xImported = xImported + 1
                    Case Else
                        MsgBox "Unrecognised CSV - """ & xFile & """ - not imported."
                        xBad = xBad + 1
                End Select
            End With
        End If
        
        xCSV.Parent.Close savechanges:=False
        Name ThisWorkbook.Path & "\" & xFile As ThisWorkbook.Path & "\Processed\" & xFile
        
        xFile = Dir()
        
    Loop Until xFile = ""

Application.ScreenUpdating = True

MsgBox "Run completed - " & xImported & " of " & xImported + xBad & " imported."

End Sub

Function Import_CSV(xFile) As String
' Unfortunately, for dd/mm/yyy users, Excel messes up dates when _programatically_ opening a CSV file.
' So we use the Wizard and specifically set the date to "dd/mm/yyyy". <Sigh>
Dim xBook As Workbook

Set xBook = Workbooks.Add

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ThisWorkbook.Path & "\" & xFile, Destination:=Range("$A$1"))
    .Name = xFile
    .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(4)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With

Import_CSV = xBook.Name

End Function

Open in new window

Bed-time now, so talk to you later.

Regards,
Brian.Report-Example-V3.xlsm
0
 
redmondbCommented:
Hi, ian_greig.

A few questions, please...
(1) Do you have any suggestion as to how we recognise the new files? A couple of possibilities (please say A!)...
    (A) The macro should delete any files it processes so any files in the folder are new.
    (B) Keep a list of all CSV's processed and check all the folder's files against it each run time.
(2) What version of Excel is used?
(3) Can we ignore the other xlsx files?
(4) Will the macro only have to deal with a single day's files, or could there be more?

Thanks,
Brian.
0
 
ian_greigAuthor Commented:
Hi Brian
Thanks for your help.
Answers to questions:
(1) Option B would be good.. as we do need to keep a copy of csv files generated in the folder
(2) Excel 2010
(3) yes -- sorry that normally won;t be there
(4) it will only be a daily file

Cheers
Ian
0
Cloud Class® Course: SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

 
redmondbCommented:
Thanks, Ian.

(4) it will only be a daily file
So, instead of having to keep a list (messy!) could we simply take the newest date from the folder?

Even better, what about a sub-folder called "Processed" - so once a file has been processed, the macro would move it to the sub-folder?

Regards,
Brian.
0
 
ian_greigAuthor Commented:
yes a sub-folder called processed would be good -- cheers Ian
0
 
redmondbCommented:
Ian,

Please see attached. The code is...
Option Explicit

Sub Daily_Run()
Dim xNext_Row_MS  As Long
Dim xNext_Row_1F  As Long
Dim xNext_Row_2F  As Long
Dim xLast_Row_CSV As Long
Dim xImported     As Long
Dim xBad          As Long
Dim xFile         As String
Dim xCSV          As Workbook

xFile = Dir(ThisWorkbook.Path & "\*.csv")
If xFile = "" Then
    MsgBox ("No CSV files found in " & ThisWorkbook.Path & "\ - run cancelled.")
    Exit Sub
End If

ThisWorkbook.Activate

xNext_Row_MS = 1 + Sheets("MS").[A1].SpecialCells(xlLastCell).Row
xNext_Row_1F = 1 + Sheets("1F").[A1].SpecialCells(xlLastCell).Row
xNext_Row_2F = 1 + Sheets("2F").[A1].SpecialCells(xlLastCell).Row

Application.ScreenUpdating = False
    
    Do
    
        Set xCSV = Workbooks.Open(ThisWorkbook.Path & "\" & xFile, Format:=2)
        xLast_Row_CSV = xCSV.Sheets(1).[A1].SpecialCells(xlLastCell).Row
        
        If xLast_Row_CSV < 2 Then
            MsgBox "Warning: """ & xFile & """ has no data."
        Else
            ''''xCSV.ActiveSheet.Range("A" & xLast_Row_CSV).Interior.Color = 5296274
            With xCSV.ActiveSheet.Range("2:" & xLast_Row_CSV).EntireRow
                Select Case Mid(xCSV.Name, 1, 2)
                    Case "MS"
                        .Copy Destination:=ThisWorkbook.Sheets("MS").Range("A" & xNext_Row_MS)
                        xNext_Row_MS = xNext_Row_MS + xLast_Row_CSV - 1
                        xImported = xImported + 1
                    Case "1F"
                        .Copy Destination:=ThisWorkbook.Sheets("1F").Range("A" & xNext_Row_1F)
                        xNext_Row_1F = xNext_Row_1F + xLast_Row_CSV - 1
                        xImported = xImported + 1
                    Case "2F"
                        .Copy Destination:=ThisWorkbook.Sheets("2F").Range("A" & xNext_Row_2F)
                        xNext_Row_2F = xNext_Row_2F + xLast_Row_CSV - 1
                        xImported = xImported + 1
                    Case Else
                        MsgBox "Unrecognised CSV - """ & xFile & """ - not imported."
                        xBad = xBad + 1
                End Select
            End With
        End If
        
        xCSV.Close savechanges:=False
        Name ThisWorkbook.Path & "\" & xFile As ThisWorkbook.Path & "\Processed\" & xFile
        
        xFile = Dir()
        
    Loop Until xFile = ""

Application.ScreenUpdating = True

MsgBox "Run completed - " & xImported & " of " & xImported + xBad & " imported."

End Sub

Open in new window

Regards,
Brian.Report-Example-V2.xlsm
0
 
ian_greigAuthor Commented:
thanks very much for that

the import worked well the only issue its seems is on the date in column one-- the date format has changed from UK (dd/mm/yyyy) into USA date format (mm/dd/yyyy):

eg 05-01-13 has been changed to 01/05/2013

The computer we use is Australian so wouldn't expect the computer settings to do this.

Do you have any suggestion?
0
 
ian_greigAuthor Commented:
That worked... so thanks for that. much appreciated.. sweet dreams
0
 
redmondbCommented:
Thanks, Ian.

I normally keep an eye on "my" closed questions for up to a month, so please feel free to post any issues here.

Regards,
Brian.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.