+ Reply to Thread
Results 1 to 2 of 2

Change code of Macro that joins CSV files

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    07-26-2012
    Location
    Netherlands
    MS-Off Ver
    Excel 2016 Office 365 ProPlus
    Posts
    826

    Change code of Macro that joins CSV files

    Hi All,
    Lets try it different.
    So this is the code I have to join data from several CSV files:

    Option Explicit
    
    #If VBA7 Then
        Private Declare PtrSafe Function OpenProcess Lib "kernel32" _
            (ByVal dwDesiredAccess As Long, _
            ByVal bInheritHandle As Long, _
            ByVal dwProcessId As Long) As Long
        
        Private Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" _
            (ByVal hProcess As Long, _
            lpExitCode As Long) As Long
    #Else
        Private Declare Function OpenProcess Lib "kernel32" _
            (ByVal dwDesiredAccess As Long, _
            ByVal bInheritHandle As Long, _
            ByVal dwProcessId As Long) As Long
        
        Private Declare Function GetExitCodeProcess Lib "kernel32" _
            (ByVal hProcess As Long, _
            lpExitCode As Long) As Long
    #End If
    
    
    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 or higher
            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 & "AMS1*.csv" _
                    & 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:=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
    Now I want to change this part:

    '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
    I do not want to browse for the folder but I want to tell the macro were to look.
    With code like this:

    'Fill in the path\folder where the files are
    'on your machine
    MyPath = "U:\Finance\Working\Freight Test\Data"
    
    'Add a slash at the end if the user forget it
    If Right(MyPath, 1) <> "\" Then
    MyPath = MyPath & "\"
    End If
    
    'If there are no Excel files in the folder exit the sub
    FilesInPath = Dir(MyPath & "AMS1*.csv")
    If FilesInPath = "" Then
    MsgBox "No files found"
    Exit Sub
    End If
    But just swap one piece of code with the other just won't do it.
    Can someone please assist in how to do this? Thanks!
    I included some CSV files to test with.
    Attached Files Attached Files

  2. #2
    Forum Contributor
    Join Date
    07-26-2012
    Location
    Netherlands
    MS-Off Ver
    Excel 2016 Office 365 ProPlus
    Posts
    826

    Re: Change code of Macro that joins CSV files

    Ok....adter 1,5 day I seem to have fixed it.
    And, as usual, the solution looked to be very simple.....
    I changed the part of code which lets you browse to a folder with this:

    '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 = "U:\Finance\Working\Freight Test\Data"
            If Right(foldername, 1) <> "\" Then
                foldername = foldername & "\"
            End If
    So block (or remove) the set oApp and the set oFolder lines and make the 'foldername' statement variable (or fixed but I will make it variable later).

    Hope this helps others with a similar problem

+ Reply to Thread

Thread Information

Users Browsing this Thread

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

Similar Threads

  1. Macro code for moving between files
    By Shift-4 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 06-20-2013, 08:53 PM
  2. SQL Multiple Joins
    By johncassell in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 03-16-2011, 12:33 PM
  3. change / modify VBA code in other files on the network
    By modytrane in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 03-04-2011, 12:23 PM
  4. Macro code to split a sheet into new files
    By chenelas in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 07-19-2009, 09:19 PM
  5. Joins in excel
    By fralo in forum Excel General
    Replies: 5
    Last Post: 03-03-2008, 12:24 PM

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