PDA

View Full Version : [SOLVED] Inserting Files From Multiple Columns - Concatentate Result File



dj44
03-25-2016, 09:27 PM
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/showthread.php?54940-Combining-Word-docs-based-on-a-design-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 :thumb

DJ

15754
Sample Files
15755
15756
15757
15758

gmayor
03-26-2016, 03:23 AM
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
03-26-2016, 12:10 PM
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.:grinhalo:

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:beerchug:

Cheers DJ