Excel - CONVERTIR CODIGO EXCEL 2003 A 2010

   
Vista:
Imágen de perfil de Anderson

CONVERTIR CODIGO EXCEL 2003 A 2010

Publicado por Anderson gato-978@hotmail.com (2 intervenciones) el 17/10/2014 04:35:36
Codial Saludo...
Por favor necesito la ayuda, de alguien... un duro que se le mida quizás algo cencillo... Convertir este código vba 2003 a código que lo pueda ejecutar en excel 2010

La macro realiza el siguiente proceso. buscar en documentos word una palabra, y colocar los datos en una hoja de calculo..

Gracias...

Desde popayan / Cauca / Colombia
----------------------------------------------------------------------------------------------------------------
Option Explicit



Sub SearchWordsInDoc()
Dim wDoc As Object
Dim wApp As Object
Dim fs As Variant
Dim lCount&, i&, sText$
Dim sFullName$, lOff&

Set fs = Application.FileSearch

Set wApp = GetWord
If wApp Is Nothing Then GoTo Fin

Application.ScreenUpdating = False

sText = "julio" '//Texto a buscar

Set fs = Application.FileSearch
With fs
.LookIn = "c:windowsescritorio" '//Carpeta de búsqueda
.SearchSubFolders = True
.Filename = "*.doc"
If .Execute(SortBy:=msoSortByLastModified, SortOrder:=msoSortOrderAscending, AlwaysAccurate:=True) > 0 Then
lCount = .FoundFiles.Count
For i = 1 To lCount
sFullName = .FoundFiles(i)
Set wDoc = wApp.Documents.Open(sFullName)
If Not wDoc Is Nothing Then
If FindText(wDoc, sText) Then
[A1].Offset(lOff).Hyperlinks.Add Anchor:=[A1].Offset(lOff), Address:=wDoc.FullName
lOff = lOff + 1
End If
wDoc.Close False
End If
Next
End If
End With

wApp.Quit

Fin:
Application.ScreenUpdating = True

Set fs = Nothing
Set wApp = Nothing
Set wDoc = Nothing
End Sub

Private Function GetWord() As Object
On Error GoTo Create
Set GetWord = GetObject(, "Word.Application")
Exit Function
Create:
Set GetWord = CreateObject("Word.Application")
End Function

Private Function FindText(ByVal Doc As Object, ByVal sText As String) As Boolean
On Error Resume Next
With Doc.Content.Find
.ClearFormatting
If .Execute(FindText:=sText) Then
FindText = True
Else
FindText = False
End If
End With
End Function

-------------------------------------------------------------------------------------------------------------------------------------
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder