Como ABRIR Archivo PDF desde un LISTBOX de Excel VBA #554

ABRIR FICHEROS PDF MEDIANTE MACRO DE EXCEL

En la macro que se presenta a continuación se podrá observar como se abre un archivo PDF con macros de Excel VBA, los archivos se encuentran listados en un listbox de Excel, seleccionando el archivo deseado y haciendo doble click sobre el ítem del listbox, se abrirá el fichero PDF correspondiente, con la aplicación predeterminada para abrir esta clase de ficheros.

Necesitas dominar Excel como un profesional, 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 el funcionamiento de este ejemplo, primero se debe listar archivos pdf que se encuentren en nuestra PC, como? no te preocupes en el link se muestra como listar los archivos de una carpeta y subcarpeta de Excel.

Se debe seleccionar un ítem o archivo de los listados en el listbox de Excel y haciendo doble click sobre el mismo se abrirá el PDF utilizando la aplicación que se tiene instalada por defecto para abrir ficheros PDF.

Explicación del código que ABRE PDF CON MACROS

El código es bastante sencillo, una vez que se tienen listados los archivos, se podrá hacer doble click en un item del listbox o nombre del archivo que se encuentra listado y se procederá a abrir fichero.

Para ello se debe colocar en el evento doble click del listbox la siguiente macro, que en un primer momento determina cual es la ruta del archivo, dato que es obtenido del mismo listbox ya que en su columna 3 se encuentra el path, se usa el código:

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

Obtenida la ruta con el siguiente código se procede a abrir el archivo PDF, utilizando el aplicativo que se tiene instalado por defecto para abrir archivos PDF, el código usado es:

ActiveWorkbook.FollowHyperlink ruta, , True

Código VBA para ABRIR ficheros PDF con Macro de 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 movio 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))
‘fila = UserForm9.ListBox1.LiAstIndex
nunmacro = 4
UserForm8.Show
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 «Mover archivos con Macros VBA»

Descarga el Libro de Excel usado como ejemplo en este post 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