Abrir subcarpeta vba Excel no funciona
No me funciona en Power Shell
Sub EVO()
Dim num As Variant
Dim FileSystemInstancia
Dim base2 As String, Namek As String
Dim ruta As String, ruta3 As String
'Ambiente
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
ruta = Environ("USERPROFILE") & "\Dropbox\DOCUMENTOS PERSONALES\CONSULTORIO\hISTORIAS CLINICAS\HC-CONSULTORIO\"
num = Sheets("Ficha").Range("F2").Value
'datos para la carpeta
Sheets("Ficha").Select
base2 = Cells(4, "F") & " " & Cells(4, "G") & " " & Cells(4, "C") & " " & Cells(4, "D") & "-" & num
ruta3 = ruta & base2
'Folder crear o encontrar
Set FileSystemInstancia = CreateObject("Scripting.FileSystemObject")
If Not FileSystemInstancia.FolderExists(ruta3) Then
MsgBox ("No hay evoluciones")
Else
Call Shell("explorer.exe" & ruta3, vbNormalFocus)
End If
End SubVariante
Sub EXA()
Dim num As Variant
Dim Carpeta As Object
Dim base2 As String, Namek As String
Dim ruta As String, ruta3 As String
Dim Folder As String
Dim FileSystemInstancia
'Ambiente
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
ruta = Environ("USERPROFILE") & "\Dropbox\DOCUMENTOS PERSONALES\CONSULTORIO\hISTORIAS CLINICAS\HC-CONSULTORIO\"
num = Sheets("Ficha").Range("F2").Value
'datos para la carpeta
Sheets("Ficha").Select
base2 = Cells(4, "F") & " " & Cells(4, "G") & " " & Cells(4, "C") & " " & Cells(4, "D") & "-" & num
ruta3 = ruta & base2
Folder = EXAMENES
'Folder crear o encontrar
Set FileSystemInstancia = CreateObject("Scripting.FileSystemObject")
If Not FileSystemInstancia.FolderExists(ruta3) Then
MsgBox ("No hay exámenes")
Else
Call Shell("explorer.exe" & ruta3 & Folder, vbNormalFocus)
End If
End Sub
