PDA

View Full Version : Word macro - need to run it from excel...



gonen
10-03-2013, 03:03 PM
Hi

this macro works perfect in Word VBA - it merges all .docx files in a given folder into single file.


can someone suggest how to run this in excel vba ???
how can I specify the new merged filename ?



Sub MergeDocs()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String
Const strFolder = "d:\aagon\data\Poi\Dropbox\Family\Miki\Envelope_to_send\"
Set MainDoc = Documents.Add
strFile = Dir$(strFolder & "*.docx")
Do Until strFile = ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
rng.InsertFile strFolder & strFile
strFile = Dir$()
Loop
End Sub



thank you very much !!!!

patel
10-05-2013, 01:29 AM
you can not use some word statements with excel

Sub MergeDocs()
strFolder = "d:\aagon\data\Poi\Dropbox\Family\Miki\Envelope_to_send\"
destfile ="d:\aagon\data\Poi\Dropbox\Family\Miki\Envelope_to_send\mergeall.docx"
strFile = Dir(strFolder & "*.docx")
If strFile = "" Then Exit Sub
With CreateObject(strFolder & strFile)
Do
strFile = Dir
If strFile = "" Then Exit Do
FName = strFolder & strFile
.Content.InsertAfter CreateObject(FName).Content
Loop
.saveas2 destfile, 12
.Close False
End With
End Sub

gonen
10-05-2013, 06:01 AM
Actually I ran some word from excel before...

I am looking for a way to merge all .docx files in a given folder into single .docx file

I need to run it from excel.


10x

patel
10-05-2013, 06:59 AM
did you try my code ?

gonen
10-05-2013, 12:23 PM
I will tomorrow ! thank you !!!!!!

gonen
10-05-2013, 09:54 PM
Hi

Your code cannot work like that as you handle docx files as regular files.

To append docx files we must use word as the triggering object to run the process.

I tried your code. It does the merge but as expected - it lose all word formatting.


thanks !!!

ZVI
10-07-2013, 07:52 PM
Try this:


Sub MergeDocs()
'ZVI:2013-10-08 http://www.vbaexpress.com/forum/showthread.php?47741-Word-macro-need-to-run-it-from-excel
Const wdCollapseEnd As Long = 0
Dim objWord As Object, strFile As String, strFolder As String

' If this workbook is saved in the same folder as the DOCs then use this line:
strFolder = ThisWorkbook.Path & "\"
' Else uncomment the line below and change it appropriately
'strFolder = "d:\aagon\data\Poi\Dropbox\Family\Miki\Envelope_to_send\"

' Get/Create Word Application object
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err <> 0 Then Set objWord = CreateObject("Word.Application")

' Trap errors
On Error GoTo exit_

' Merge DOCs in the new Document
With objWord.Documents.Add.Range
strFile = Dir$(strFolder & "*.doc*")
While Len(strFile)
.Collapse wdCollapseEnd
.InsertFile strFolder & strFile
strFile = Dir$
Wend
End With

exit_:

objWord.Visible = True
If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number

End Sub

gonen
10-07-2013, 09:02 PM
Zvi

This worked very nice but the generated merged doc file lost the original documents formatting.

for example - textboxes are not in the right place
right to left is not there anymore
word table does not look the same

so the process works perfect. it merges - but the results are not looking the same...


I tried a manual process like this :

step 1:
edit the first doc in the folder (not open a new doc)

step 2
add a page break at the bottom of the doc
place the cursor on this new page (on the bottom of the doc)

step 3:
insert >> object >> text from file
I selected the next file (only one file)
insert



results were perfect.
the new doc looked as it should. one document after the other with all formatting ok

so I repeated step 2 and step 3 for all the files in the directory - one after the other (only one doc each time)


can this be automated from within excel ???????

I think the key point here is to edit the first doc in the folder (and not to start from blank doc)

p.s.
when I did the same process (steps 2 and 3) after editing a blank doc - results were not good and it lost the formatting.
when i tried to insert more than one file at the same time in step 3 - results were not good so I inserted only one file at a time.



thank you for your time and help !!!!!!

ZVI
10-07-2013, 10:09 PM
Then may be this:


Sub MergeDocs1()
'ZVI:2013-10-08 http://www.vbaexpress.com/forum/showthread.php?47741-Word-macro-need-to-run-it-from-excel
Const wdCollapseEnd As Long = 0, wdPageBreak As Long = 7
Dim objWord As Object, strFile As String, strFile1 As String, strFolder As String

' If this workbook is saved in the same folder as the DOCs then use this line:
strFolder = ThisWorkbook.Path & "\"
' Else uncomment the line below and change it appropriately
'strFolder = "d:\aagon\data\Poi\Dropbox\Family\Miki\Envelope_to_send\"

' Get/Create Word Application object
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err <> 0 Then Set objWord = CreateObject("Word.Application")

' Trap errors
On Error GoTo exit_

' Find name of the 1st document and save it
strFile = Dir$(strFolder & "*.doc*")
strFile1 = strFile

' Merge documents
If Len(strFile) Then
With objWord.Documents.Open(strFolder & strFile, , True).Range
While Len(strFile)
If strFile <> strFile1 Then
With .Characters.Last
.Collapse wdCollapseEnd
.InsertBreak wdPageBreak
.InsertFile strFolder & strFile
End With
End If
strFile = Dir$
Wend
End With
End If

exit_:

objWord.Visible = True
If Err Then MsgBox strFile & vbLf & Err.Description, vbCritical, "Error #" & Err.Number

End Sub

gonen
10-07-2013, 11:01 PM
PERFECT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !!!!

this is a perfect word documents merger.

All looks exactly like I printed them in a row.


THANK YOU VERY VERY MUCH !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

gonen
10-07-2013, 11:18 PM
Could you pls add few lines to the code that will save the merged new file to a new file name (without actually touching the original file) ?


many thanks !!!!!

snb
10-08-2013, 04:03 AM
@ZVI


sub M_snb()
sn=split(createobject("wscript.shell").exec("cmd /c Dir G:\OF\*.doc /b").stdout.readall,vbcrlf)

for j=0 to ubound(sn)
with getobject(sn(j))
c00=c00 & .content
.close 0
end with
next

open "G:\OF\together.txt" for output as #1
print #1,c00
close #1
End Sub

gonen
10-08-2013, 05:01 AM
Hi snb

I gave your code a quick shot and I got:

Automation error (Error 440)

on

With GetObject(sn(j))

j=0anyway - thanks for your efforts

Zvi got it done (hopefully he will spit the piece of code to write the output into a new filename.

thanks !!!

patel
10-08-2013, 05:10 AM
snb, did you read this post ?


I tried your code. It does the merge but as expected - it lose all word formatting.

ZVI
10-08-2013, 02:10 PM
Could you pls add few lines to the code that will save the merged new file to a new file name (without actually touching the original file) ?
Sure, use this code:


Sub MergeDocs2()
'ZVI:2013-10-08 http://www.vbaexpress.com/forum/showthread.php?47741-Word-macro-need-to-run-it-from-excel
Const DestFile As String = "AllMerged.docx"
Const wdCollapseEnd As Long = 0, wdPageBreak As Long = 7, wdFormatDocument As Long = 0, wdFormatXMLDocument As Long = 12
Dim objWord As Object, strFile As String, strFile1 As String, strFolder As String, strDestFile As String

' If this workbook is saved in the same folder as the DOCs then use this line:
strFolder = ThisWorkbook.Path & "\"
' Else uncomment the line below and change it appropriately
'strFolder = "d:\aagon\data\Poi\Dropbox\Family\Miki\Envelope_to_send\"

' Get/Create Word Application object
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err <> 0 Then Set objWord = CreateObject("Word.Application")

' Trap errors
On Error GoTo exit_

' Kill previous result
strDestFile = DestFile
If Val(objWord.Version) < 12 Then strDestFile = Left(strDestFile, Len(strDestFile) - 1)
If Len(Dir(strFolder & strDestFile)) > 0 Then Kill strFolder & strDestFile

' Find name of the 1st document and save its name
strFile = Dir$(strFolder & "*.doc*")
strFile1 = strFile

' Merge documents
If Len(strFile) Then
With objWord.Documents.Open(strFolder & strFile, , True)
While Len(strFile)
If strFile <> strFile1 And strFile <> strDestFile Then
With .Range.Characters.Last
.Collapse wdCollapseEnd
.InsertBreak wdPageBreak
.InsertFile strFolder & strFile
End With
End If
strFile = Dir$
Wend
' Save the result
.SaveAs strFolder & strDestFile, FileFormat:=IIf(Val(objWord.Version) < 12, wdFormatDocument, wdFormatXMLDocument)
' Uncomment the next line to close the resulting document
'.Close False
End With
End If

exit_:

objWord.Visible = True
If Err Then MsgBox strFile & vbLf & Err.Description, vbCritical, "Error #" & Err.Number

' Release the memory
Set objWord = Nothing

End Sub

ZVI
10-08-2013, 02:24 PM
@ZVI


sub M_snb()
sn=split(createobject("wscript.shell").exec("cmd /c Dir G:\OF\*.doc /b").stdout.readall,vbcrlf)
' ...
With getobject(sn(j)) ...

Hi snb,
Thank you, it's really nice + short + fast and I saw it in your posts and in site.
The only disadvantage is a short blinking of a DOS window.
But may be it is because of my not modern PC and a pair of glasses ;)
Vlad

gonen
10-08-2013, 09:45 PM
Hi Zvi

that works perfect. the merged file was created with the new name.


one more point...

say I have a folder with 700 files.
any idea how can I merge them in groups of xx files ?
merging all 700 docs into one created huge file...

for example:
grouping by 3 files will take:

file01 file02 file03 and merged them into group01
file04 file05 file06 and merged them into group02

I guess the files are processed sorted by name - so file01 means the first file, file04 means the fouth file an so on...


that will make the MergeDocs2 Sub accept a parameters of : number of files in group...





thanks for sharing this code. !!!

snb
10-09-2013, 02:16 AM
@ZVI

Nothing wrong with your eyes, glasses nor computer.
The shot blinking is inevitable, but the advantages of this method hugely compensate that minor nuisance.

@gonen

My suggestions are never solutions.
You will have to analyse the suggestions and adapt them.

gonen
10-09-2013, 02:22 AM
sure. thanks !!!!

ZVI
10-10-2013, 06:27 PM
@gonen
Have found this thread is still not solved.

I guess the files are processed sorted by name - so file01 means the first file, file04 means the fouth file an so on...
Dir() does not process sorted.
For example, file_01.xls and fileA_02.xls are processed by Dir in this order:
fileA_02.xls
file_01.xls

@snb
For regret, one more issue has been discovered with usage of .stdout.readall
Stdout returns DOS (ASCII) characters, and if the file names are not in English then they are converted by VBA to unicode incorrectly.
Have tested it with Russian names, the additional converting from cp866 codepage solves the problem, but for me the dependency from localizations (who knows their codepages?) is not good.
But with English names it works well.
To avoid blinking I would rather use: CreateObject("WScript.shell").Run "cmd /c Dir /b /ON C:\Temp\MyFolder\*.xls* > C:\Temp\MyFolder\MyDir.tmp" , 0, True
and then read temporary file: s = CreateObject("Scripting.FileSystemObject").OpenTextFile("C:\Temp\MyFolder\MyDir.tmp").ReadAll
with: Kill "C:\Temp\MyFolder\MyDir.tmp"
where /ON provides correct names sorting.

gonen
10-10-2013, 11:32 PM
@Zvi

I am using your code that merge the folder file into a new filename.

My problem is that I have 700 files in the folder.

I would like to be able to merge the 700 files in groups of 50 - giving the merged file - a name like allmerged01,02,03 etc.
in this case I will have 14 merged files...

p.s. merged files can be stored in different folder if that helps.


can this be done ?
maybe ability to get the number of files in group as parameter ?



Thanks for your help !!!!

snb
10-11-2013, 01:27 AM
@ZVI

That is exactly what I want to avoid: writing to a file and reading that file in a separate line of code.
In your case you can use the immediate command:


Shell "cmd /c Dir /b /ON C:\Temp\MyFolder\*.xls* > C:\Temp\MyFolder\MyDir.tmp",0

instead of


CreateObject("WScript.shell").Run "cmd /c Dir /b /ON C:\Temp\MyFolder\*.xls* > C:\Temp\MyFolder\MyDir.tmp" , 0, True

I can't replicate the non-Latin aplhabet restriction because I haven't got them (luckily) on my system.

It's very simple to order the presentation of the found files, whether by name, size or date.