Abir archivos de Word con Excel
Se trata de abrir varios y copiar su contenido en un solo Word. Por ejemplo mi Excel es:
1 X Actividades
2 X Carga
3 Productos
4 X Trabajos
donde se pone X es porque se abrirá el archivo de Word correspondiente (1.doc, 2.doc, etc.) para copiar su información (si no se captura X no se abrirá su documento), se pegará en un Word (rc.doc) agregándose (sin borrar lo anterior) cada nuevo texto, así el ejemplo anterior se vaerá como sigue:
Actividades
Texto de ejemplo.
Carga
Otro texto de ejemplo
Trabajos
Tercer y último párrafo que quedará en rc.doc.
--------------
Mi intento:
Sub RC()
Dim appWd As Object
Dim RC
RC = "c:\rc.doc"
For i = 1 To 4
If Cells(i, 2) = "X" Then
archivo = i & ".doc"
Set appWd = CreateObject("Word.Application")
appWd.Visible = True
appWd.Documents.Open "c:\" & archivo
With CreateObject("Word.Application")
appWd.Documents "c:\" & archivo
Selection.WholeStory
Selection.Copy
appWd.Documents.Close "c:\" & archivo
End With
appWd.Documents.Open (RC)
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.TypeParagraph
Selection.PasteAndFormat (wdPasteDefault)
Selection.TypeParagraph
Selection.TypeParagraph
appWd.Documents.Close (RC)
Else
End If
Next i
End SubPor ejemplo mi Excel es:
1 X Actividades
2 X Carga
3 Productos
4 X Trabajos
donde se pone X es porque se abrirá el archivo de Word correspondiente (1.doc, 2.doc, etc.) para copiar su información (si no se captura X no se abrirá su documento), se pegará en un Word (rc.doc) agregándose (sin borrar lo anterior) cada nuevo texto, así el ejemplo anterior se vaerá como sigue:
Actividades
Texto de ejemplo.
Carga
Otro texto de ejemplo
Trabajos
Tercer y último párrafo que quedará en rc.doc.
--------------
Mi intento:
Sub RC()
Dim appWd As Object
Dim RC
RC = "c:\rc.doc"
For i = 1 To 4
If Cells(i, 2) = "X" Then
archivo = i & ".doc"
Set appWd = CreateObject("Word.Application")
appWd.Visible = True
appWd.Documents.Open "c:\" & archivo
With CreateObject("Word.Application")
appWd.Documents "c:\" & archivo
Selection.WholeStory
Selection.Copy
appWd.Documents.Close "c:\" & archivo
End With
appWd.Documents.Open (RC)
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.TypeParagraph
Selection.PasteAndFormat (wdPasteDefault)
Selection.TypeParagraph
Selection.TypeParagraph
appWd.Documents.Close (RC)
Else
End If
Next i
End Sub
1 X Actividades
2 X Carga
3 Productos
4 X Trabajos
donde se pone X es porque se abrirá el archivo de Word correspondiente (1.doc, 2.doc, etc.) para copiar su información (si no se captura X no se abrirá su documento), se pegará en un Word (rc.doc) agregándose (sin borrar lo anterior) cada nuevo texto, así el ejemplo anterior se vaerá como sigue:
Actividades
Texto de ejemplo.
Carga
Otro texto de ejemplo
Trabajos
Tercer y último párrafo que quedará en rc.doc.
--------------
Mi intento:
Sub RC()
Dim appWd As Object
Dim RC
RC = "c:\rc.doc"
For i = 1 To 4
If Cells(i, 2) = "X" Then
archivo = i & ".doc"
Set appWd = CreateObject("Word.Application")
appWd.Visible = True
appWd.Documents.Open "c:\" & archivo
With CreateObject("Word.Application")
appWd.Documents "c:\" & archivo
Selection.WholeStory
Selection.Copy
appWd.Documents.Close "c:\" & archivo
End With
appWd.Documents.Open (RC)
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.TypeParagraph
Selection.PasteAndFormat (wdPasteDefault)
Selection.TypeParagraph
Selection.TypeParagraph
appWd.Documents.Close (RC)
Else
End If
Next i
End SubPor ejemplo mi Excel es:
1 X Actividades
2 X Carga
3 Productos
4 X Trabajos
donde se pone X es porque se abrirá el archivo de Word correspondiente (1.doc, 2.doc, etc.) para copiar su información (si no se captura X no se abrirá su documento), se pegará en un Word (rc.doc) agregándose (sin borrar lo anterior) cada nuevo texto, así el ejemplo anterior se vaerá como sigue:
Actividades
Texto de ejemplo.
Carga
Otro texto de ejemplo
Trabajos
Tercer y último párrafo que quedará en rc.doc.
--------------
Mi intento:
Sub RC()
Dim appWd As Object
Dim RC
RC = "c:\rc.doc"
For i = 1 To 4
If Cells(i, 2) = "X" Then
archivo = i & ".doc"
Set appWd = CreateObject("Word.Application")
appWd.Visible = True
appWd.Documents.Open "c:\" & archivo
With CreateObject("Word.Application")
appWd.Documents "c:\" & archivo
Selection.WholeStory
Selection.Copy
appWd.Documents.Close "c:\" & archivo
End With
appWd.Documents.Open (RC)
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.TypeParagraph
Selection.PasteAndFormat (wdPasteDefault)
Selection.TypeParagraph
Selection.TypeParagraph
appWd.Documents.Close (RC)
Else
End If
Next i
End Sub