Help creating a file joining different other files

[ropbasuel]

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

[Bob Phillips]

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

[ropbasuel]

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!

[ropbasuel]

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)

[Bob Phillips]

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

[ropbasuel]

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

[Bob Phillips]

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

[ropbasuel]

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!

[Bob Phillips]

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

[ropbasuel]

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!

[ropbasuel]

Can anyone help me out on this question?

Thanks