Como ABRIR Archivo WORD desde un LISTBOX de Excel VBA # 555

MACRO DE EXCEL PARA ABRIR FICHEROS WORD

En esta ocasión muestro una macro que permite abrir archivos word que se que se encuentran listados en un Listbox de Excel, es decir otra macro lista los archivos de Excel en un Listbox y una vez que se encuentran listados haciendo doble click en el ítem del listbox relacionado con el archivo de WORD se procede a abrir Word para ver el documento.

Si necesitas manejar Excel ya sea desde cero o en forma avanzada haz click acá, si quieres aprender sobre Excel en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet, te lo recomiendo no te arrepentirás.

  

Para un mejor y más fácil entendimiento sugiero descargar el archivo de Excel utilizado en el ejemplo, lo cual se puede hacer desde el final de post en forma absolutamente gratuita.

Para ver como funciona el ejemplo, primero se debe listar los archivos de una carpeta y subcarpeta de Excel, luego estos archivos son mostrados en el listbox que se encuentra en el formulario, el resultado luego de seleccionar la carpeta de la cual se desea listar los archivos, será un listado de ficheros existente en el directorio, esta macro específicamente permite abrir archivos de Word, si se requiere abrir archivos PDF o Excel se debe mirar el siguiente play list.

Explicación código para Abrir Ficheros Word con VBA

Primero se obtiene la extensión del archivo, ya que esto nos permitirá saber que tipo de archivo es y en base a ello usar tal o cual programa para abrir el fichero, el código es:

archi1 = UserForm9.ListBox1.List(UserForm9.ListBox1.ListIndex, 1)
cad = StrReverse(archi1)
lug = InStr(cad, «.»)
ext = Mid(cad, 1, lug – 1)
archi = StrReverse(ext)

Luego se obtiene la ruta o path del archivo, se carga en la variable path1, el cual es obtenido de la columna 3 de listbox que tiene listados los ficheros, se usa el código:

path1 = UserForm9.ListBox1.List(UserForm9.ListBox1.ListIndex, 3)

Posteriormente se verifica si el archivo existe, ya que se puede haber listado los archivos los cuales serán cargados en listbox y haber borrado el archivo, así que antes de abrir el fichero, la macro verificará si aún existe el fichero listado, con el siguiente código:

Set verexi = CreateObject(«Scripting.FileSystemObject»)
If verexi.FileExists(path1) Then

Luego se usa el método Select … Case para utilizar distintas aplicaciones para abrir los diferentes tipos de archivos: 

Select Case archi

Case Is = «pdf»
ActiveWorkbook.FollowHyperlink path1, , True

En caso de ser documento de Word, cuyas extensiones determinadas con código anteriormente son: docx, doc, docm, docba, entonces se usará el siguiente código, si existen otros documentos que se puedan abrir con Word solo basta agregarlos en este Case, el código es el siguiente:

Case Is = «docx», «doc», «docm», «docba»

Cón este código propiamente se Crea el Objeto Word y abre el archivo en el cual hicimos doble click:
Set wdApp = CreateObject(«Word.Application»)
Set wdDoc = wdApp.Documents.Open(path1)

Con este código hacemos visible el objeto Word, activamos dicho documento y establecemos en modo Maximizado

wdApp.Visible = True
wdDoc.Activate
ActiveWindow.WindowState = xlMaximized

Código VBA para ABRIR ficheros de WORD con MACROS EXCEL VBA

Código insertado en el formulario 8

Private Sub CommandButton1_Click()
Dim resp As Integer
On Error Resume Next

If TextBox1 = «admin» Then
Unload Me

Select Case nunmacro
Case Is = 1
resp = MsgBox(«Está por eliminar el archivo seleccionado, seguro requiere eliminar el fichero?», vbInformation + vbOKCancel, «AVISO»)
If resp = 1 Then
‘Vuelve a preguntar por segunda vez que confirme eliminación archivo
resp = MsgBox(«El archivo no se podrá recuperar, seguro requiere eliminar el archivo seleccionado?», vbCritical + vbOKCancel, «AVISO»)
If resp = 1 Then
Kill (myfilekill)
UserForm9.ListBox1.RemoveItem fila
MsgBox («El archivo se eliminó con éxito»), vbInformation, «AVISO»
End If
End If
Case Is = 2
resp = MsgBox(«Está por cambiar el nombre del archivo seleccionado, seguro requiere editar el nombre del fichero?», vbInformation + vbOKCancel, «AVISO»)
If resp = 1 Then
nomfich = Application.InputBox(prompt:=»Establezca el nuevo nombre del archivo:», Type:=2)
nomcap = StrReverse(nomold)
exten = Left(nomcap, InStr(nomcap, «.») – 1)
exten = StrReverse(exten)
nomcap = Mid(nomcap, InStr(nomcap, «\») + 1)
nomcap = StrReverse(nomcap)
nomnew = nomcap & «\» & nomfich & «.» & exten
Name nomold As nomnew

UserForm9.ListBox1.List(fila, 1) = nomfich & «.» & exten
UserForm9.ListBox1.List(fila, 3) = nomnew
MsgBox («El archivo se renombró con éxito»), vbInformation, «AVISO»
End If

Case Is = 3
resp = MsgBox(«Está por mover el archivo seleccionado, seguro requiere mover de directorio el fichero?», vbInformation + vbOKCancel, «AVISO»)
If resp = 1 Then
path1 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path

nomcap = StrReverse(folold)
nomcap = Left(nomcap, (Len(nomcap) – (Len(nomcap) – InStr(nomcap, «\»)) – 1))
nomfich = StrReverse(nomcap)
folnew = path1 & «\» & nomfich
Name folold As folnew

UserForm9.ListBox1.List(fila, 1) = nomfich
UserForm9.ListBox1.List(fila, 3) = folnew
MsgBox («El archivo se movió con éxito»), vbInformation, «AVISO»
End If

Case Is = 4
resp = MsgBox(«Se va a copiar el archivo seleccionado, seguro requiere copiar el fichero?», vbInformation + vbOKCancel, «AVISO»)
If resp = 1 Then
path1 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path

nomcap = StrReverse(copyoldarc)
nomcap = Left(nomcap, (Len(nomcap) – (Len(nomcap) – InStr(nomcap, «\»)) – 1))
nomfich = StrReverse(nomcap)
copynewarc = path1 & «\» & nomfich
FileCopy copyoldarc, copynewarc

MsgBox («El archivo se copió con éxito»), vbInformation, «AVISO»
End If


End Select

Else
MsgBox («La clave ingresada para eliminar archivos es incorrecta, verifique»), vbInformation, «AVISO»
TextBox1 = Clear
TextBox1.SetFocus
End If
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Click()

End Sub

Código insertado en el formulario 9

Private Sub CommandButton24_Click()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path1 As String, subcarpeta As Object

UserForm9.Caption = «ARCHIVOS ASOCIADOS»
UserForm9.ListBox1.ColumnCount = 5
UserForm9.ListBox1.ColumnWidths = «20 pt; 320 pt; 100 pt; 1000 pt»

‘Indicamos la ruta de donde vamos a obtener
path1 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path
If path1 = «» Then
MsgBox «No ha seleccionado directorio, seleccione un directorio .», , «AVISO»
Exit Sub
End If
‘Se crea FileSystemObject que da acceso al sistema de archivos del sistema
Set fso = CreateObject(«Scripting.FileSystemObject»)
‘Definimos variables para determinar nombre de archivos y subcarpetas
Set carpeta = fso.getfolder(path1)
Set ficheros = carpeta.Files
Set subcarp = carpeta.SubFolders

UserForm9.ListBox1.Clear
UserForm9.ListBox1.AddItem

‘Esto es para ver archivos dentro de la subcarpeta del nombre del archivo y de la Circunscripción Correspondiente
For Each subcarp In subcarp
f = subcarp.Name
Set carpetasubfol = fso.getfolder(subcarp)
Set ficherossubfol = carpetasubfol.Files
For Each ficherossubfol In ficherossubfol
b = ficherossubfol.Name
NunFic = NunFic + 1
UserForm9.ListBox1.AddItem NunFic
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 1) = b
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 2) = FileDateTime(ficherossubfol)
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 3) = subcarp & «\» & b
‘End If
Next ficherossubfol
Next subcarp

‘Archivos
For Each ficheros In ficheros
b = ficheros.Name
esp = InStr(b, » «)
nomfic = Val(Left(b, esp))
NunFic = NunFic + 1
UserForm9.ListBox1.AddItem NunFic
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 1) = b
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 2) = FileDateTime(ficheros)
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 3) = carpeta & «\» & b
Next ficheros

Set carpetasubfol = Nothing
Set ficherossubfol = Nothing
Set carpeta = Nothing
Set ficheros = Nothing

UserForm9.ListBox1.List(0, 0) = «ID»
UserForm9.ListBox1.List(0, 1) = «Nombre de Archivo»
UserForm9.ListBox1.List(0, 2) = «Fecha de Creación / Modificación»
UserForm9.ListBox1.List(0, 3) = «Path»

UserForm9.ListBox1.AddItem
UserForm9.ListBox1.AddItem
UserForm9.ListBox1.AddItem
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 3) = «Total de registros: » & UserForm9.ListBox1.ListCount – 4

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Private Sub CommandButton25_Click()
On Error Resume Next
myfilekill = (UserForm9.ListBox1.List(ListBox1.ListIndex, 3))
fila = UserForm9.ListBox1.ListIndex
nunmacro = 1
UserForm8.Show
End Sub

Private Sub CommandButton26_Click()
Unload UserForm9
End Sub

Private Sub CommandButton27_Click()
On Error Resume Next
nomold = (UserForm9.ListBox1.List(ListBox1.ListIndex, 3))
fila = UserForm9.ListBox1.ListIndex
nunmacro = 2
UserForm8.Show
End Sub

Private Sub CommandButton28_Click()
On Error Resume Next
folold = (UserForm9.ListBox1.List(ListBox1.ListIndex, 3))
fila = UserForm9.ListBox1.ListIndex
nunmacro = 3
UserForm8.Show
End Sub

Private Sub CommandButton29_Click()
On Error Resume Next
copyoldarc = (UserForm9.ListBox1.List(ListBox1.ListIndex, 3))
nunmacro = 4
UserForm8.Show
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.DisplayAlerts = False
archi1 = UserForm9.ListBox1.List(UserForm9.ListBox1.ListIndex, 1)
cad = StrReverse(archi1)
lug = InStr(cad, «.»)
ext = Mid(cad, 1, lug – 1)
archi = StrReverse(ext)
path1 = UserForm9.ListBox1.List(UserForm9.ListBox1.ListIndex, 3)

Set verexi = CreateObject(«Scripting.FileSystemObject»)
If verexi.FileExists(path1) Then

Select Case archi

Case Is = «pdf»
ActiveWorkbook.FollowHyperlink path1, , True

Case Is = «docx», «doc», «docm», «docba»

Set wdApp = CreateObject(«Word.Application»)
Set wdDoc = wdApp.Documents.Open(path1)
wdApp.Visible = True
wdDoc.Activate
ActiveWindow.WindowState = xlMaximized
Exit Sub

End Select
End If

End Sub

Private Sub UserForm_Initialize()
UserForm9.Top = 100
UserForm9.Left = 135
UserForm9.Width = 830
UserForm9.Height = 350
End Sub

Descarga la Macro de Excel «ABRIR archivos WORD con Macros VBA»

Desde aquí podrás descargar el fichero de Excel usado como ejemplo y en el vídeo explicativo, el mismo es totalmente gratuito y libre su uso, solicito aportar para sostener esta web, si está dentro de tus posibilidades, desde ya muchas gracias.

Donate:
Cuenta Paypal: https://paypal.me/programarexcel
Cuenta Bitcoin: 1KBGGb8fyDzyR3X1Rie6m7VguzaAfngNbd
Cuenta Ether: 0x41Bbd24556914C83a31217eBb3BC49789b66e407