Copia/incolla in background da word a word

[emoj]

Salve a tutti,
da un pò di tempo sto cercando da fare un applicativo in VBA che in pratica dovrebbe risolvere un problemino abbastanza "tosto" che hanno i miei colleghi nel fare delle offerte in word partendo da tanti fogli word (configurazioni+opzioni) che aprono, copiano il contenuto, aprono il foglio word "master" dell'offerta ed incollano i vari contenuti in cascata.
I volevo conoscere se esiste la possibilità di, da codice VBA, copiare da una serie di fogli word ed incollare, in base ad una priorità in configurazione, tutto il contenuto su di un unico foglio master (OFFER) e salvarlo.
Io, ad esempio, uso questo codice VBA:

Sub Crea Offerta_Click(Source As Button)

If Dir("c:\masterDOC.doc")<>"" Then Kill "c:\masterDOC.doc"

'documento primo da incollare
Set ex=createobject("Word.Application")
ex.visible=False
Call ex.documents.open("c:\nomeDOC1.doc")
ex.visible=False
ex.Selection.WholeStory
ex.Selection.Copy
ex.Documents.Add
ex.Selection.PasteSpecial
ex.ActiveDocument.SaveAs ("c:\masterDOC.doc")
ex.visible=False
ex.Quit
Set ex = Nothing

Set ex=createobject("Word.Application")
ex.visible=False
Call ex.documents.open("c:\nomeDOC2.doc")
ex.visible=False
ex.Selection.WholeStory
ex.Selection.Copy

Call ex.documents.open("c:\masterDOC.doc")

ex.Selection.PasteSpecial
ex.ActiveDocument.SaveAs ("c:\masterDOC.doc")
ex.Quit
Set ex = Nothing

'documenti ulteriori da incollare
'...


'ultimo documento da incollare
Set ex=createobject("Word.Application")
ex.visible=False
Call ex.documents.open("c:\nomeDOCn.doc")
ex.visible=False
ex.Selection.WholeStory
ex.Selection.Copy

Call ex.documents.open("c:\masterDOC.doc")

ex.Selection.PasteSpecial
ex.ActiveDocument.SaveAs ("c:\masterDOC.doc")
ex.Quit
Set ex = Nothing

Msgbox "Elaborazione completata."

End Sub


...con questo codice, però, noto che, avendo un PC pentium 4 2.2 GHz con 1024 MB RAM, quando lancio l'operazione sopra descritta, la CPU va al 100 % di attività ed il tempo di esecuzione sale in base al numero di fogli word utilizzati (ogni file word "pesa" circa 80-90 KB!), quindi tenete presente che la mia elaborazione può salire fino a 20-30 files word da copiare ed incollare, quindi mi occorrono + di 30 min. per eseguirla!!!.
Se qualcuno comunque avesse un'idea migliore ben venga!

Grazie per la vostra immensa attenzione e pazienza!
A presto

Emiliano

[dragone bianco]

Primo devi semplificare il codice utilizzando un Loop del seguente codice

If Dir("c:\masterDOC.doc")<>"" Then Kill "c:\masterDOC.doc"

'documento primo da incollare
Set ex=createobject("Word.Application")
ex.visible=False
Call ex.documents.open("c:\nomeDOC1.doc")
ex.visible=False
ex.Selection.WholeStory
ex.Selection.Copy
ex.Documents.Add
ex.Selection.PasteSpecial
ex.ActiveDocument.SaveAs ("c:\masterDOC.doc")
ex.visible=False
ex.Quit
Set ex = Nothing

In vba è possibile avere un elenco dei file contenuti in una cartella.
Il loop eseguirà il codice da te scritto, cambiando di volta in volta il codice.

Es:

With Application.FileSearch
    .FileName = "99*.*"
    .LookIn = "C:\My Documents"
    .Execute
    For I = 1 to .FoundFiles.Count
        MsgBox .FoundFiles(I)
    Next I
End With

Questo esempio elenca tutti i file che iniziano con 99 e si trovano nella cartella C:\My Documents
Per ogni file appare un messaggio.

Ciao