Consulting

Results 1 to 11 of 11

Thread: Help creating a file joining different other files

  1. #1

    Help creating a file joining different other files

    Dear friends,

    I'm in a situation where I'm really struggling to get it solved. I really don't know if what I'm asking is even possible to do with VBA code, but here it goes:

    I have one folder with hundreds of files in a format that is editable with a text editor. I want to join all of those files into one (to use on other application). But the thing is, to create this file there are some conditions that have to be met so that the created file can be read with by the other application.

    The files are sorted alphabetically. I have file a.sp2 , b.sp2 , c.sp2 , ....

    The code should start reading a.sp2 file and all this file content should be copied to the new-file, then it should read b.sp2 and it should only copy from line 83 to the end of b.sp2 file to the end of the previously created file. Then it should read c.sp2 file and copy from line 83 to the end of c.sp2 file to the new created file , and so on...

    So basically the code should copy all the content of the first file and then join the content (starting on line 83 to the end) from all the other files in that folder.

    I will attach a zip file with example files (a.sp2 , b.sp2 , c.sp2) and a desired output for the code (output.sp2).

    Thank you so much for any help given

    Best Regards
    Attached Files Attached Files

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,079
    Location
    You can do it in Power Query.

    Change the folder name and the name of the first file in the if test.

    let
        _folder.path = "D:\Projects\_8 Community\_forums\VBAExpress\VBAX - 64985 - Join Files",
        _first.file = "a.sp2",
    
        Source = Folder.Files(_folder.path),
        hiddenFile.Filter = Table.SelectRows(Source, each [Attributes]?[Hidden]? <> true),
        contentCol.Add = Table.AddColumn(hiddenFile.Filter, "Files", each #"Transform File from VBAX - 64985 - Join Files"([Content])),
        sourceCol.Rename = Table.RenameColumns(contentCol.Add, {"Name", "Source.Name"}),
        surplusCols.Remove = Table.SelectColumns(sourceCol.Rename, {"Source.Name", "Files"}),
        errorRows.Remove = Table.RemoveRowsWithErrors(surplusCols.Remove, {"Files"}),
        fileContent.Expand = Table.ExpandTableColumn(errorRows.Remove, "Files", Table.ColumnNames(#"Transform File from VBAX - 64985 - Join Files"(#"Sample File"))),
        dataCol.Rename = Table.RenameColumns(fileContent.Expand,{{"Column1", "Data"}}),
        data.Type = Table.TransformColumnTypes(dataCol.Rename,{{"Source.Name", type text}, {"Data", type text}}),
        idCol.Add = Table.AddColumn(data.Type, "Id", each 1),
    
        TableType = Value.Type(Table.AddColumn(idCol.Add, "Running Cost", each null, type number)),
        fnRunningSum = (MyTable as table) as table =>
        let
            Source = Table.Buffer(MyTable),
            TableType = Value.Type(Table.AddColumn(Source, "Running Cost", each null, type number)),
            Cumulative = List.Skip(List.Accumulate(Source[Id],{0},(cumulative,Id) => cumulative & {List.Last(cumulative) + Id})),
            AddedRunningSum = Table.FromColumns(Table.ToColumns(Source)&{Cumulative},TableType)
        in
            AddedRunningSum,
        rowsGrouped = Table.Group(idCol.Add, {"Source.Name"}, {{"GroupedData", fnRunningSum, TableType}}),
        rowsExpanded = Table.ExpandTableColumn(rowsGrouped , "GroupedData", {"Data", "Running Cost"}, {"Data", "Running Cost"}),
        tokeepCol.Add = Table.AddColumn(rowsExpanded, "Keepers", each if [Source.Name] = _first.file then true else if [Running Cost] > 83 then true else false),
        originalData.Keep = Table.SelectColumns(tokeepCol.Add,{"Data"})
    in
        originalData.Keep
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    Dear xld,

    Thank you so much for trying to help me!! I don't know what do refer by "Power Query". I have tried to use the code on excel VBA programmer but I'm getting an error. I suspect this code isn't to be used in this way.

    Is it possible to adapt this code to be used on the VBA excel programmer?

    Thank you so much!

  4. #4
    Dear xld,

    I have realised that PowerQuery is an add-on for MSOffice. The problem is that I'm currently using Office 2007 which is not supported by PowerQuery. Is there any way around without using PowerQuery?


    Thanks

    Edit: It also doesn't work on Windows Vista (What I am using)
    Last edited by ropbasuel; 04-12-2019 at 10:45 AM.

  5. #5
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,079
    Location
    2007! I feel for you, that is a poor Excel.

    This VBA should do it.

    Option Explicit
    
    Public Sub GetFiles()
    Dim target As Worksheet
    Dim wb As Workbook
    Dim parentFolder As Object
    Dim file As Object
    Dim nextrow As Long
    Dim myFolder As String
    Dim notFirst As Boolean
    
        Application.ScreenUpdating = False
    
        With ThisWorkbook
        
            Set target = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            target.Name = "Merged Data"
        End With
        
        With Application.FileDialog(msoFileDialogFolderPicker)
        
            .Title = "Select Folder"
            .InitialFileName = vbNullString
            .AllowMultiSelect = False
            
            If .Show = -1 Then
            
                If .SelectedItems.Count > 0 Then
               
                    myFolder = .SelectedItems(1)
                End If
            Else
            
                Exit Sub
            End If
        End With
     
        Set parentFolder = CreateObject("Scripting.FileSystemObject").GetFolder(myFolder)
        
        nextrow = 1
        For Each file In parentFolder.Files
        
            Set wb = GetFile(file.Path, IIf(notFirst, 83, 1))
            wb.Worksheets(1).UsedRange.Copy target.Cells(nextrow, 1)
            nextrow = target.Cells(target.Rows.Count, "A").End(xlUp).Row + 1
            wb.Close SaveChanges:=False
            notFirst = True
        Next file
        
        Application.ScreenUpdating = True
    End Sub
    
    Private Function GetFile( _
        ByVal Filepath As String, _
        ByVal Startrow As Long) As Workbook
        Workbooks.OpenText Filename:=Filepath, _
                            Origin:=xlMSDOS, _
                            Startrow:=Startrow, _
                            DataType:=xlDelimited, _
                            TextQualifier:=xlDoubleQuote, _
                            ConsecutiveDelimiter:=False, _
                            Tab:=True, Semicolon:=False, _
                            Comma:=False, _
                            Space:=False, _
                            Other:=False, _
                            FieldInfo:=Array(1, 1), _
                            TrailingMinusNumbers:=True
        Set GetFile = ActiveWorkbook
    End Function
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  6. #6
    Dear xld,

    Thank you so much for trying to help me!! It really means a lot!! Thank you!!

    Well, I have tried to run the code and this is what happens: It asks me for a folder, which I pick the one with the .sp2 files, and then after I select "OK" I get the following message:

    "myfilename.xlsm is already open. If you open again again, all changes made will be lost. Do you want to open again myfilename.xlsm?"

    If I press Yes - I get back to where I was
    If I press No - I get the following error: https://i.imgur.com/8IsHzL0.png (Method 'OpenText' of object 'Workbooks' failed)

    Again, thank you so much for your time!!

    EDITED: The link of the error
    Last edited by ropbasuel; 04-12-2019 at 12:34 PM.

  7. #7
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,079
    Location
    Do you have that .xlsm file in your sp2 folder, it sounds like it.

    Not sure about the problem as I don't have it, but does this sort it?

        Option Explicit
        
        Public Sub GetFiles()
        Dim target As Worksheet
        Dim wb As Workbook
        Dim parentFolder As Object
        Dim file As Object
        Dim nextrow As Long
        Dim myFolder As String
        Dim notFirst As Boolean
        
            Application.ScreenUpdating = False
        
            With ThisWorkbook
            
                Set target = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
                target.Name = "Merged Data"
            End With
            
            With Application.FileDialog(msoFileDialogFolderPicker)
            
                .Title = "Select Folder"
                .InitialFileName = vbNullString
                .AllowMultiSelect = False
                
                If .Show = -1 Then
                
                    If .SelectedItems.Count > 0 Then
                   
                        myFolder = .SelectedItems(1)
                    End If
                Else
                
                    Exit Sub
                End If
            End With
         
            Set parentFolder = CreateObject("Scripting.FileSystemObject").GetFolder(myFolder)
            
            nextrow = 1
            For Each file In parentFolder.Files
            
                If Mid$(file.Path, InStrRev(file.pah, "."), 99) = ".sp2" Then
                
                    Set wb = GetFile(file.Path, IIf(notFirst, 83, 1))
                    wb.Worksheets(1).UsedRange.Copy target.Cells(nextrow, 1)
                    nextrow = target.Cells(target.Rows.Count, "A").End(xlUp).Row + 1
                    wb.Close SaveChanges:=False
                    notFirst = True
                End If
            Next file
            
            Application.ScreenUpdating = True
        End Sub
        
        Private Function GetFile( _
            ByVal Filepath As String, _
            ByVal Startrow As Long) As Workbook
            Workbooks.OpenText Filename:=Filepath, _
                                Origin:=xlMSDOS, _
                                Startrow:=Startrow, _
                                DataType:=xlDelimited, _
                                TextQualifier:=xlDoubleQuote, _
                                ConsecutiveDelimiter:=False, _
                                Tab:=True, Semicolon:=False, _
                                Comma:=False, _
                                Space:=False, _
                                Other:=False, _
                                FieldInfo:=Array(1, 1), _
                                TrailingMinusNumbers:=True
            Set GetFile = ActiveWorkbook
        End Function
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  8. #8
    Dear xld,

    Thank you again for your reply! You are right. I had my .xlsm on my sp2 folder. Now I have moved the .xlsm file to other folder and I can run without errors the 1st code you have given to me.

    The code now works without any problem, in the end I got my Excel sheet with the information from the .sp2 files but I don't think it exports to any .sp2 file, at least I can't find where the export file is. Am I doing something wrong?

    I'm sorry for my questions and again thanks a lot for your help!


    EDIT- I have clicked on File -> Save as Unicode Text (.txt) and got a file almost like I wanted to be. On this print I show some differences that I don't know if it can be solved. Please see the image that I post here: https://i.imgur.com/ogUWfmT.png

    Again, can't thank you enough for your help!
    Last edited by ropbasuel; 04-12-2019 at 07:12 PM. Reason: More info

  9. #9
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,079
    Location
    The code wasn't saving it, you were not missing anything.

    This version saves it as "Merged Data.sp2" in the same folder, as an MS-DOS text file, seems to be okay, but you will know better than I.

    Option Explicit
    
    Public Sub GetFiles()
    Const TARGET_SHEET_NAME As String = "Merged Data"
    Dim target As Worksheet
    Dim wb As Workbook
    Dim parentFolder As Object
    Dim file As Object
    Dim nextrow As Long
    Dim myFolder As String
    Dim notFirst As Boolean
    
        Application.ScreenUpdating = False
    
        With ThisWorkbook
        
            Call DeleteSheet(TARGET_SHEET_NAME)
            
            Set target = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            target.Name = TARGET_SHEET_NAME
        End With
        
        With Application.FileDialog(msoFileDialogFolderPicker)
        
            .Title = "Select Folder to Merge"
            .InitialFileName = vbNullString
            .AllowMultiSelect = False
            
            If .Show = -1 Then
            
                If .SelectedItems.Count > 0 Then
               
                    myFolder = .SelectedItems(1)
                End If
            Else
            
                Exit Sub
            End If
        End With
     
        Set parentFolder = CreateObject("Scripting.FileSystemObject").GetFolder(myFolder)
        
        nextrow = 1
        For Each file In parentFolder.Files
        
            If Mid$(file.Path, InStrRev(file.Path, "."), 99) = ".sp2" Then
            
                Set wb = GetFile(file.Path, IIf(notFirst, 83, 1))
                wb.Worksheets(1).UsedRange.Copy target.Cells(nextrow, 1)
                nextrow = target.Cells(target.Rows.Count, "A").End(xlUp).Row + 1
                wb.Close SaveChanges:=False
                notFirst = True
            End If
        Next file
        
        Worksheets(TARGET_SHEET_NAME).Move
        ActiveWorkbook.SaveAs Filename:=myFolder & Application.PathSeparator & TARGET_SHEET_NAME & ".sp2", _
                              FileFormat:=xlTextMSDOS, _
                              CreateBackup:=False
        ActiveWorkbook.Close
        
        Application.ScreenUpdating = True
    End Sub
    
    Private Function GetFile( _
        ByVal Filepath As String, _
        ByVal Startrow As Long) As Workbook
        Workbooks.OpenText Filename:=Filepath, _
                            Origin:=xlMSDOS, _
                            Startrow:=Startrow, _
                            DataType:=xlDelimited, _
                            TextQualifier:=xlDoubleQuote, _
                            ConsecutiveDelimiter:=False, _
                            Tab:=True, Semicolon:=False, _
                            Comma:=False, _
                            Space:=False, _
                            Other:=False, _
                            FieldInfo:=Array(1, 1), _
                            TrailingMinusNumbers:=True
        Set GetFile = ActiveWorkbook
    End Function
    
    Private Function DeleteSheet(ByVal sh As String) As Boolean
    
        Application.DisplayAlerts = False
        
        On Error Resume Next
        ActiveWorkbook.Worksheets(sh).Delete
        On Error GoTo 0
    
        Application.DisplayAlerts = True
    End Function
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  10. #10
    Dear xld,

    Again I can't thank you enough from trying to help me! You have been very considerate to me! Thank you!

    Well, I have tried the new code and it runs without any problem. Automatically saves the .sp2 file to the folder perfectly.

    The only thing that is not working so well is for example on line 55 and 85 of the merged.sp2. If you compare this file with the output.sp2 file that I originally attached in the first post you can see this kind of differences: https://i.imgur.com/xKjs9Gb.png

    Are these issues solvable?

    Again much respect for your willing to help me!

  11. #11
    Can anyone help me out on this question?

    Thanks

Posting Permissions

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