Inserting Files From Multiple Columns - Concatentate Result File

[dj44]

Folks,

Good Day to all.


My task seems very complex, and I am needing some help.

Good man Graham made this macro found below, I simply wanted to adapt it a little bit - but
after weeks of fiddling about - i have got no where, i am turning it over to the pros.


http://www.vbaexpress.com/forum/show...esign-in-Excel

I tried to attach zip file with all the materials in it forum would not upload so attahced xlsm and sample docs

- i hope it makes more sense than i am

The file names are stored in the column. They are then chosen using a number system as the order in which they should be concatendaed and then out put.


I am trying to save a file based on file names found horizontally accross instead of the original design which is verticlaly down.

so I changed the code to this:

oRng.InsertFile Filename:=strDocsPath & xlSheet.Cells(j, 4) & ".docx"_
 & xlSheet.Cells(j, 5) & ".docx" & ".docx"  & xlSheet.Cells(j, 6) & ".docx"

I know its wrong as it did not work.

Now knowing that my vba skills in excel too are very basic, i am looking for some help.


How would I save the output files by taking the file names from across multiple columns horizontally.

Thank you very much for your valuable time and help - I sure do appreciate it

DJ

Concatentae Files.xlsm
Sample Files
1000.docx
1001.docx
1002.docx
1003.docx

[gmayor]

If I understand correctly, it's just a matter of swapping rows for columns and eliminating the unused columns A to C.

I have left in the headers that were in the original. If you don't need them, remove them from the code.

Option Explicit

Sub CreateTest2()
Dim wdApp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim LastCol As Long, LastRow As Long
Dim i As Long, j As Long, k As Long
Dim iQuestion As Long
Dim xlSheet As Worksheet
Const strDocsPath As String = "C:\Path\Docs\"
Const strPath As String = "C:\Path\Output\"
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err Then
        Set wdApp = CreateObject("Word.Application")
        Err.Clear
    End If
    wdApp.ScreenUpdating = False
    Set xlSheet = ActiveSheet
    With xlSheet
        LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row    'Check Col D as there is nothing in Col A
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    For i = 2 To LastRow    'Row 2 to Last Row
        iQuestion = 0
        Set wdDoc = wdApp.Documents.Add
        For j = 5 To LastCol    'Column E to Last Column
            If xlSheet.Cells(i, j) > 0 Then
                iQuestion = iQuestion + 1
                Set oRng = wdDoc.Range
                oRng.collapse 0
                oRng.Text = "Question " & iQuestion & vbCr
                oRng.Style = "Heading 2"
                oRng.ParagraphFormat.keepwithnext = True
                oRng.collapse 0
                oRng.InsertFile Filename:=strDocsPath & xlSheet.Cells(i, j) & ".docx"
                oRng.End = wdDoc.Range.End
                oRng.Style = "Normal"
                oRng.Text = Replace(oRng.Text, vbCr & vbCr, vbCr)
                wdDoc.Fields.Unlink
                Set oRng = wdDoc.Range
            End If
        Next j
        wdDoc.Range.Font.Reset
        wdDoc.Range.Style.Reset

        wdDoc.SaveAs2 Filename:=strPath & xlSheet.Cells(i, 4) & ".docx", AddToRecentFiles:=False    'Column D
        wdDoc.Close    'Optional
        DoEvents
    Next i
    MsgBox "Documents created at " & strPath
    wdApp.ScreenUpdating = True
lbl_Exit:
    Set xlSheet = Nothing
    Set wdApp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

[dj44]

Graham,

you have blown me away with this gesture. I have been learning all about transposing the columns and what not, I could not work out how to swap them.

Now I am chuffed as bits and bits.

This is very important to me as all my files were a mess - now i can just do a combine of them and not have to copy and paste, and then reformat into 2018 if you get my drift.

You are a very good man for helping us newbies.

I am very happy there are good folks like you who can help us, i did try for ages - but it wouldn't start up with my coding skills.

thanks to you - its well sorted now.

Also i came across this good macro when i was searching for how to list my word files in excel column, then i had an idea i could use this to organise my word documents. You see i got thousands of docs that have descriptions and well its a big headache not knowing what is in what file.

Any way THANK YOU VERY VERY MUCH

1. For making this macro in the begining
2. for adapting the columns - transpositing them so I get the file name horizontally.


I hope You have a great chilled weekend Graham,

thanks for making mine

Cheers DJ