Results 1 to 9 of 9

VBA / Macro Help -Adding file name as column to existing Import Multiple Text File Macro

Threaded View

  1. #1
    Registered User
    Join Date
    01-11-2007
    Posts
    94

    VBA / Macro Help -Adding file name as column to existing Import Multiple Text File Macro

    Hello All,

    Appreciate help this forum and contributor provides.

    I have existing macro (below) which combines (50+) multiple text file delimited via "|" from given folder and saves as as excel table. I want to add text file name to given record field in table so i know where I pulled this record from and which file it belongs to. Can this be done in this macro? I have to do this every day so this would help in validation.

    Folder has multiple .txt file like below

    I_CNNSR6_09112012.txt
    E_CBSSR6_09122012.txt

    I want to add file name as column field against the record from that file let say E_CBSSR6_09122012.txt file has following records (or multiple) pulled in table

    Location|Product1 |38080090|7500|KGS|7510937.5
    Location|Product2 |38081090| 500|KGS|751937.5

    I want get this way in my table columns

    Col A Col B Col C Col D Col E Col F Col G
    Location Product1 38080090 7500 KGS 7510937.5 E_CBSSR6_09122012
    Location Product2 38081090 500 KGS 751937.5 E_CBSSR6_09122012

    Thanks
    NKRA


    Credit to following for following macro site http://www.rondebruin.nl/csv.htm

    Macro

    ' 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 CSV 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 csv 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:=False, _
            Space:=False, Other:=True, OtherChar:="|"
    
            '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
    Last edited by NKRA; 11-11-2012 at 07:14 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1