Macro para abrir archivo de otro pc que me permita elegir carpeta

Una primer a aproximación sería que pidieras el nombre de la carpeta mediante un inputbox, por ejemplo:

Sub visor()
dim miCarpeta as String
miCarpeta=InputBox("Escriba el nombre de la carpeta que contiene el archivo")
If StrPtr(miCarpeta) = 0 OR Nz(miCarpeta,"")="" Then Exit Sub
carpeta = "\\Cultivos3\Ir a Sala\" & miCarpeta & "\"
archivo = "Lunes.jpg"
ShellExecute 0, "open", carpeta & archivo, "", "", 1
End Sub

Una segunda opción sería utilizar el objeto FileDialog, que abrirá una ventana emergente en la que puedes seleccionar la carpeta.
Para esto, copia esta función en un módulo nuevo:

'------------------------------------------------------------------------------------------------
' Función para abrir ventana de diálogo y elegir la carpeta donde exportar la documentación
'------------------------------------------------------------------------------------------------
Public Function fncSelectCarpeta() As String
On Error GoTo sol_err
Dim fDialog As Office.FileDialog
miRuta = Application.CurrentProject.Path
'Creamos el Objecto FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
'Configuramos las características de nuestra ventana de diálogo
With fDialog
    .Title = "Selecciona la carpeta donde se va a exportar el archivo"
    .ButtonName = "Aceptar"
    .InitialView = msoFileDialogViewList
    .InitialFileName = miRuta & "\"
    'Detectamos el botón pulsado por el usuario
    If .Show = -1 Then
        'Asignamos a la función la carpeta seleccionada, convirtiéndola a un valor de tipo String
        fncSelectCarpeta = CStr(.SelectedItems.Item(1))
    Else
        'No hacemos nada
    End If
End With
Salida:
    Exit Function
sol_err:
    MsgBox "Se ha producido el error: " & Err.Number & " - " & Err.Description, vbInformation,"ERROR"
    Resume Salida
End Function

El siguiente paso es registrar la librería “Microsoft Office xx.x Object Library"

Por último, tu código quedaría así:

Sub visor()
carpeta = fncSelectCarpeta()
If Nz(carpeta,"")="" Then Exit Sub
archivo = "Lunes.jpg"
ShellExecute 0, "open", carpeta & "\" & archivo, "", "", 1
End Sub

Muchísimas gracias por atender mi petición.

En ambos casos la macro se detiene en Nz. Dice: Error de compilación no se ha definido sub o función. Algo hago mal pero no se el que.

Un saludo y gracias de nuevo

Pero no me fijé que tu pregunta iba enfocada a Excel, y te respondí pensando en Access...

En Excel no existe la función Nz, por eso te da error. Solución, cambia Nz(carpeta,"")="" por carpeta=""

Debiera funcionarte.

Gracias de nuevo por tu respuesta.

Perdona pero no entiendo de programación y copio como los loros. Cambio 

Nz(carpeta,"")=    ó    Nz(miCarpeta,"")=  del primer supuesto que me has indicado

Por "" carpeta="" y varias combinaciones que he hecho y en la mayoría me dice que se esperaba Then o GoTo, y es que cuando uno no sabe pues..., no sabe.

Aún así gracias enormes.

Tendría que quedarte así:

1/ opción primera:

Sub visor()
dim miCarpeta as String
miCarpeta=InputBox("Escriba el nombre de la carpeta que contiene el archivo")
If StrPtr(miCarpeta) = 0 OR miCarpeta="" Then Exit Sub
carpeta = "\\Cultivos3\Ir a Sala\" & miCarpeta & "\"
archivo = "Lunes.jpg"
ShellExecute 0, "open", carpeta & archivo, "", "", 1
End Sub

Si así aun te sigue dando error, cambia esta linea:

If StrPtr(miCarpeta) = 0 OR miCarpeta="" Then Exit Sub

por esta otra:

If StrPtr(miCarpeta) = 0  Then Exit Sub

2./ segunda opción:

Sub visor()
carpeta = fncSelectCarpeta()
If carpeta="" Then Exit Sub
archivo = "Lunes.jpg"
ShellExecute 0, "open", carpeta & "\" & archivo, "", "", 1
End Sub

Y si te da error, elimina la linea:  If carpeta="" Then Exit Sub