Hola,
Tengo esta situación. Necesito bajar la información de varios formularios en word a una hoja de excel. En una pestaña estoy poniendo la lista de los doc's con todo y ruta, y en otra toda la información bajada. Funciona muy bien una vez, pero en la 2ª se atora invariablemente.
Abajo pongo el código, ya lo corrí como loop y sin loop, y en ambos casos me marca error en:
For Each oShape In ActiveDocument.InlineShapesY no doy con el error. En realidad soy nuevo en VBA, así que puede ser que el error sea una cosa simple.
Gracias de antemano por la ayuda, saludos.
'Requiere reference: MSWord 11.0 Object Library
Sub ImportWordData()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' VAR'S
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim wdApp As Object
Dim wd As Object
Dim wordFilename As String
Dim oShape As Word.InlineShape
Dim r As Range
Dim counter, i As Integer
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' CODE
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Gran Loop, un ciclo por .doc, se inicializa el contador
i = 1
Do While Not IsEmpty(Sheets("files2open").Cells(i, "A"))
'Input
wordFilename = Sheets("files2open").Cells(i, "A")
'prepara wdApp
On Error Resume Next
Set wdApp = GetObject("Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
'Prepara el formulario en .doc para ser abierto
Set wd = wdApp.Documents.Open(wordFilename)
wdApp.Visible = False
'Escoje el lugar desdd tempData para empezar a poner la info
Sheets("tempData").Activate
Cells(1, 1).Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
'Pone el valor de OptionButton/CheckBox/Label en el siguiente renglón
counter = 0
For Each oShape In ActiveDocument.InlineShapes
Select Case (oShape.OLEFormat.progID)
Case "Forms.Label.1"
ActiveCell.Offset(0, counter).Value = oShape.OLEFormat.Object.Caption
counter = counter + 1
Case "Forms.OptionButton.1"
ActiveCell.Offset(0, counter).Value = oShape.OLEFormat.Object.Value
counter = counter + 1
Case "Forms.CheckBox.1"
ActiveCell.Offset(0, counter).Value = oShape.OLEFormat.Object.Value
counter = counter + 1
End Select
Next oShape
wd.Close: Set wd = Nothing
wdApp.Quit: Set wdApp = Nothing
i = i + 1
'Final del gran Loop
Loop
0:
End Sub