Addition to code

Dear VBA Express Community,

I have the following code, allowing me to combine the contents of several CSV files into 1 sheet. It works great, but I was wondering if it is also possible to add the file name in a column to the left of the contents (so offset 1 left)

Would be extremely grateful for any help I might be able to get on this!

Kind regards,
Eyass



[VBA]' Start Code

Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
lpExitCode As Long) As Long

Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103


Public Sub ShellAndWait(ByVal PathName As String, Optional WindowState)
Dim hProg As Long
Dim hProcess As Long, ExitCode As Long
'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)
Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE
End Sub


Sub Merge_CSV_Files()
Dim BatFileName As String
Dim TXTFileName As String
Dim XLSFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim DefPath As String
Dim Wb As Workbook
Dim oApp As Object
Dim oFolder
Dim foldername

'Create two temporary file names
BatFileName = Environ("Temp") & _
"\CollectCSVData" & Format(Now, "dd-mm-yy-h-mm-ss") & ".bat"
TXTFileName = Environ("Temp") & _
"\AllCSV" & Format(Now, "dd-mm-yy-h-mm-ss") & ".txt"

'Folder where you want to save the Excel file
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If

'Set the extension and file format
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsx": FileFormatNum = 51
'If you want to save as xls(97-2003 format) in 2007 use
'FileExtStr = ".xls": FileFormatNum = 56
End If

'Name of the Excel file with a date/time stamp
XLSFileName = DefPath & "MasterCSV " & _
Format(Now, "dd-mmm-yyyy h-mm-ss") & FileExtStr

'Browse to the folder with CSV files
Set oApp = CreateObject("Shell.Application")
Set oFolder = oApp.BrowseForFolder(0, "Select folder with Txt files", 512)
If Not oFolder Is Nothing Then
foldername = oFolder.Self.Path
If Right(foldername, 1) <> "\" Then
foldername = foldername & "\"
End If

'Create the bat file
Open BatFileName For Output As #1
Print #1, "Copy " & Chr(34) & foldername & "*.txt" _
& Chr(34) & " " & TXTFileName
Close #1

'Run the Bat file to collect all data from the CSV files into a TXT file
ShellAndWait BatFileName, 0
If Dir(TXTFileName) = "" Then
MsgBox "There are no txt files in this folder"
Kill BatFileName
Exit Sub
End If

'Open the TXT file in Excel
Application.ScreenUpdating = False
Workbooks.OpenText Filename:=TXTFileName, Origin:=xlWindows, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, _
Space:=False, Other:=False

'Save text file as a Excel file
Set Wb = ActiveWorkbook
Application.DisplayAlerts = False
Wb.SaveAs Filename:=XLSFileName, FileFormat:=FileFormatNum
Application.DisplayAlerts = True

Wb.Close savechanges:=False
MsgBox "You find the Excel file here: " & vbNewLine & XLSFileName

'Delete the bat and text file you temporary used
Kill BatFileName
Kill TXTFileName

Application.ScreenUpdating = True
End If
End Sub

' End code


[/VBA]

Quote:

---

Originally Posted by Eyass

I was wondering if it is also possible to add the file name in a column to the left of the contents

---

I can not see your sheet, where you want add file name ? do you want add a column before colum A ?

After column A would be fantastic! No need for the full folder path to the file, just the filename would be great!


So:
Column A Column B
Contents 1 Filename A
Contents 2 Filename B
....
Contents n Filename n

attach 2 csv file for testing

I think you only need 2 lines of VBA:

[vba]
sub M_snb()
shell "cmd /c copy G:\OF\*.csv G:\OF\integration.csv"
workbooks.open "G:\OF\integration.csv"
end sub
[/vba]


I don't see any use in adding the originating filename (why integrating them ??)
You'd better change the title of this thread to: 'reduction of code'.

OK, but we need a break between the two commands, how can we do ?

Thanks a lot for the hlep, guys!

Have attached a sample of what the output file would look like - hopefully this should better explain what I am trying to achieve :)

Thanks a lot!

do you remember ?

Quote:

---

Originally Posted by patel

attach 2 csv file for testing

---

Open each file as a recordset and paste its contents ...

[vba]Import "C:\SomeFolder", "csv"

Sub Import(path As String, Optional extension As String)
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.folderexists(path) Then
Set folder = fso.GetFolder(path)
Set cnn = CreateObject("ADODB.connection")
Set rs = CreateObject("ADODB.Recordset")

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & path & ";" & _
"Extended Properties='text;HDR=YES;FMT=Delimited'"
'Chang HDR to NO if no header ^^^^^^^

For Each f In folder.Files
If UCase(Right(f.Name, Len(extension))) = UCase(extension) Then
Sql = "SELECT *, '" & f.Name & "' AS Filename FROM [" & f.Name & "]"
rs.Open Sql, cnn, 3, 3, &H1
ActiveCell.CopyFromRecordset rs
rs.Close
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
End If
Next
End If
End Sub[/vba]