Consulting

Results 1 to 9 of 9

Thread: Addition to code

  1. #1
    VBAX Newbie
    Joined
    Nov 2012
    Posts
    3
    Location

    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]

  2. #2
    VBAX Mentor
    Joined
    Jul 2012
    Posts
    398
    Location
    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 ?

  3. #3
    VBAX Newbie
    Joined
    Nov 2012
    Posts
    3
    Location
    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

  4. #4
    VBAX Mentor
    Joined
    Jul 2012
    Posts
    398
    Location
    attach 2 csv file for testing

  5. #5
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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'.

  6. #6
    VBAX Mentor
    Joined
    Jul 2012
    Posts
    398
    Location
    OK, but we need a break between the two commands, how can we do ?

  7. #7
    VBAX Newbie
    Joined
    Nov 2012
    Posts
    3
    Location

    Output Example

    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!
    Attached Files Attached Files

  8. #8
    VBAX Mentor
    Joined
    Jul 2012
    Posts
    398
    Location
    do you remember ?

    Quote Originally Posted by patel
    attach 2 csv file for testing

  9. #9
    VBAX Expert
    Joined
    Oct 2012
    Posts
    726
    Location
    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]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •