Need a Macro that will copy many files into one. 3

[snowcold]

Hello all,

First off, I hope this is the right location for this post...

Here is the deal:
We have a measuring device that for each material it measures, it produces a .csv file.
If this device measures 60 different materials, it produces 60 different .csv files.

I would like to have a macro that will take these 60 files and create 1 .csv file or a .xls file that will contain 60 different worksheets, one worksheet for each original .csv file.

4 things:
1- I have never created a macro.
2- Is this even possible?
3- We are using Excel 2002.
4- Could you provide a direction for me to look to create this macro.


Thanks a bunch!

 

[AlexIT]

Open Excel, start Macro Record, open the first csv, open the second csv, stop recording. Now look at the recorded macro, you will see how to import each csv to a worksheet. Make this loop.

 

[mp9]

I use two functions in an Excel spreadsheet for this, GetData and PutData:

Sub GetData()
    Dim varInput() As Variant, lngStart As Long, i As Integer
    Application.StatusBar = "Select CSV files to stitch together..."
    varInput = Application.GetOpenFilename("All files (*.*), *.*", 1, "Please select files to stitch...", "Select", True)
    lngStart = Application.WorksheetFunction.CountA(Columns("A:A"))
    For i = LBound(varInput) To UBound(varInput)
        Application.ActiveSheet.Cells(lngStart + i, 1) = varInput(i)
    Next i
    Range("A" & LBound(varInput) + lngStart & ":A" & UBound(varInput) + lngStart).Select
    Application.ActiveSheet.Unprotect
    Selection.Sort Key1:=Range("A" & LBound(varInput) + lngStart), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    Application.ActiveSheet.Protect
    Range("B1").Select
    Application.StatusBar = False
End Sub
Sub PutData()
    Dim strOutput As String, lngStart As Long, i As Integer
    lngStart = Application.WorksheetFunction.CountA(Columns("A:A"))
    If lngStart > 1 Then
        Application.StatusBar = "Specify output CSV file..."
        strOutput = Application.GetSaveAsFilename(vbNullString, "CSV files (*.csv), *.csv", 1, "Please specify output file...", "Save")
        If Application.ActiveSheet.Range("A:A").Find(strOutput, LookIn:=xlValues) Is Nothing Then
            Dim fs, fo, fi
            Dim booGo As Boolean
            Set fs = CreateObject("Scripting.FileSystemObject")
            If fs.fileexists(strOutput) Then
                booGo = (MsgBox("This will overwrite the existing file. Are you sure you wish to proceed?", vbYesNo + vbDefaultButton2 + vbQuestion, "Confirm") = vbYes)
            Else
                booGo = True
            End If
            If booGo Then
                For i = 2 To lngStart
                    If i = 2 Then
                        Set fo = fs.opentextfile(strOutput, 2, True, tristatefalse)
                    Else
                        Set fo = fs.opentextfile(strOutput, 8, True, tristatefalse)
                    End If
                    Set fi = fs.opentextfile(Application.ActiveSheet.Cells(i, 1), 1, False, tristatefalse)
                    Do While fi.AtEndOfStream <> True
                        fo.writeline (fi.readline)
                    Loop
                    fi.Close
                    fo.Close
                    Application.StatusBar = "Stitched " & i - 1 & "/" & lngStart - 1 & " files..."
                Next i
                Application.StatusBar = "Complete"
                MsgBox "Stitched " & lngStart - 1 & " files successfully." & vbCrLf & vbCrLf & "Please sanity-check the composite file.", vbInformation, "Complete"
            Else
                Application.StatusBar = "Cancelling..."
                MsgBox "File 'stitch' cancelled by user operation.", vbInformation, "Cancelled"
            End If
        Else
            Application.StatusBar = "Error in output file specified..."
            MsgBox "Sorry, you can't output to a file that's on the input list.", vbExclamation, "Error"
        End If
    Else
        Application.StatusBar = "Error in input files specified..."
        MsgBox "Sorry, no input files have been specified.", vbExclamation, "Error"
    End If
    Range("C1").Select
    Application.StatusBar = False
End Sub

I then have two command buttons to call the two functions.

GetData prompts you to specify the csv files to be stitched together and lists them in column A of the spreadsheet (I have a caption in A1, which is why the listing starts from A2 down).

PutData prompts you to specify an output file and stitches the csv's specified using GetData into one long file.

Works for me....

http://www22.brinkster.com/accessory/

 

[snowcold]

Thanks for the responses...

AlexIT: Not quite sure what is meant by looking at the macro. I did what you posted, opened 2 csv files and stopped recording.
All that was given to me by the macro was:

Sub copy2()
'
' copy2 Macro
' Macro recorded 4/20/2006 by Administrator
'
' Keyboard Shortcut: Ctrl+w
'
    Application.WindowState = xlMinimized
    Application.WindowState = xlMinimized
    Windows("Measures.csv").Activate
End Sub

mp9:
nice little code snipet, thanks.
I implemented that macro, choose the files and then it created a third file. All nice, but when I went to open the new file, I received an error message saying the the .csv file was corrupt....

Not too sure about that.

Question though, it appears that your macro is "stitching" all the data onto one worksheet, is this true?


Thanks again

 

[AlexIT]

Sorry I thought the recorder would pick up a little bit more...try this:

Sub CSV_Files()

'Just setting up for the open file portion
Set fso = CreateObject("Scripting.FileSystemObject")
CSVfoldername = "c:\temp\"
Set CSVfolder = fso.GetFolder(CSVFoldername)
j = 1

'Open only .csv files using import wizard to convert to Excel
For Each File In CSVfolder.Files
If Right(File.Name, 4)= ".csv" Then

Application.ScreenUpdating = False
Workbooks.Open Filename:=File, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False

j=j+1

End If
Next

'Name Excel file the sum of number of files
XLSFileName = "C:\temp\" & "Create " & j & ".xls"

'Save the file
Set Wb = ActiveWorkbook
Application.DisplayAlerts = False
Wb.SaveAs Filename:=XLSFileName, FileFormat:=xlWorkbookNormal
Application.DisplayAlerts = True

'Close Excel
Wb.Close savechanges:=False

Application.ScreenUpdating = True

'Clear the variables
j = 0
Set fso = Nothing

End Sub

 

[mp9]

Yes, the code concatenattes all the CSVs into one sheet. I'm sure it could be mopdified to move on to a new sheet for each file. Again, recording a macro yourself to insert a new sheet will give you the syntax.

http://www22.brinkster.com/accessory/

 

[snowcold]

Again, Thanks to all for the help...

mp9: I'm looking at your putdata sub and I'm looking to add the functionality of adding a new worksheet. I have added the line Sheet.Add but this adds the new worksheets to the current workbook, rather than the user selected one in your macro...

Where in the code are you writting the files?

I am looking to take the string variable strOutput and add the worksheets to that file....


thanks

 

[snowcold]

anyone?

 

[taupirho]

Just an idea.

Do you need to do this in a macro?

The DOS copy command will do what you want fairly easily.

If you NEED to do it in a macro create a dos batch file with the copy command in it then call the DOS batch file from within VBA using shell.

 

[snowcold]

No, I guess it doesn't need to be a macro...I just need the task performed....

could you expand?

 

[taupirho]

Lets assume you have a directory (e.g c:\mycsvs) set aside which only contains the CSV files you want to concatenate. The following simple DOS command will create one new file that is a concatenation of all the CSV files in that directory


copy c:\mycsvs\*.csv c:\master.csv

 

[snowcold]

Thanks for the replies..But I need each file to be its own worksheet...

 

[pbail1]

Hi Snowcold

I have adapted AlexIt's script to import all the CSV files into the same file, putting each CSV file into a separate worksheet.

It assumes that the CSV files are all saved in the same folder and that no other CSV files are lurking in the folder you don't want (as this script will import them!)

In order to get it to work - change the CSVFoldername variable to where you have the files saved.

Sub CSV_Files()

    'Just setting up for the open file portion
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'Change the folder to the location where the CSV files are stored
    
    csvfoldername = "E:\"
    Set CSVfolder = fso.GetFolder(csvfoldername)

    For Each file In CSVfolder.Files
        If Right(file.Name, 4) = ".csv" Then
            Sheets.Add
            
            'Names the sheet after the file - restricts length to maximum 31 characters
            'allowed when naming an excel sheet
            
            ActiveSheet.Name = Left(file.Name, 31)
            
            
            With ActiveSheet.QueryTables.Add(Connection:= _
                "TEXT;" & file, Destination:=Range("A1"))
                .Name = Right(file.Name, (Len(file.Name) - Len(csvfoldername)))
                
                .PreserveFormatting = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePlatform = xlWindows
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileCommaDelimiter = True
                .Refresh BackgroundQuery:=False
            End With
        End If
                        
    Next
    
    'get rid of the default sheets we did not use
    
    Application.DisplayAlerts = False
    
    For Each Worksheet In Worksheets
    
        If Left(Worksheet.Name, 5) = "Sheet" Then
        
            Sheets(Worksheet.Name).Delete
            
        End If
        
    Next
    
    Application.DisplayAlerts = True

    'tidy up
    
    Set fso = Nothing

End Sub

 

[snowcold]

That works perfectly.....

Thanks!!!!



side-note
I've modified it to attempt to sort the records but now I am receiving a run-time error...see my new post if interested.

 

[snowcold]

both posts pointed me in the right direction....

thanks again to alll!

 

[AlexIT]

Star for pbail1!