Vincular en excel libros con distintas contraseñas

.04/11/16

Hola, Juan Pablo

La instrucción clave que abre archivos con contraseñas es como la siguiente:

Workbooks.Open "C:\LIBRO1.xls", Password:="PASSWORD1"

Asumiendo que tenés todas las claves de esos archivos, es posible hacerlo a través de una macro como la que te paso a continuación.

Desde luego tendrás que reemplazar en este código los nombres de archivo y claves que puse ahí por los reales de tus archivos. También la carpeta donde están ubicados todos, si que -ojalá- fuese la misma.

Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:

Sub AbrirTodos()
'---- Variables modificables ----
'=== JUAN PABLO, modificá estos datos de acuerdo a tu proyecto:
DirBusc = "C:\CarpetaDeArchivos" 'carpeta donde están los archivos a abrir
Extension = "xls*" 'Extensión de los archivos a consolidar. Dejar "*" para que sean todos
'---- fin Variables
'
'---- inicio de rutina:
'  
DirBusc = DirBusc & IIf(Right(DirBusc, 1) = "\", "", "\")
LosArchivos = Dir(DirBusc & "*." & Extension)
'Application.DisplayAlerts = False
'Application.ScreenUpdating = False
Do While LosArchivos <> ""
    Application.StatusBar = ">>>>>>>>>>>>>> Un momento, Abriendo archivo " & Left(LosArchivos, InStr(1, LosArchivos, Extension) - 2)
    Abrir = False
    ElArchivo = Left(LosArchivos, InStr(1, LosArchivos, Extension) - 2)
    Select Case ElArchivo
    'JUAN PABLO, reemplazá abajo los nombres de los archivos y claves:
        Case "Archivo1" 'poner el nombre del 1º archivo, sin extensión
            LaClave = "qwerty1" ' clave correspondiente al 1º archivo"
            Abrir = True
    '
        Case "Archivo2" 'poner el nombre del 2º archivo, sin extensión
            LaClave = "qwerty2" ' clave correspondiente al 2º archivo"
            Abrir = True
    '
        Case "Archivo3" 'poner el nombre del 3º archivo, sin extensión
            LaClave = "qwerty3" ' clave correspondiente al 3º archivo"
            Abrir = True
    '
        Case "Archivo4" 'poner el nombre del 4º archivo, sin extensión
            LaClave = "qwerty4" ' clave correspondiente al 4º archivo"
            Abrir = True
    '
        Case "Archivo5" 'poner el nombre del 5º archivo, sin extensión
            LaClave = "qwerty5" ' clave correspondiente al 5º archivo"
            Abrir = True
    '
        Case "Archivo6" 'poner el nombre del 6º archivo, sin extensión
            LaClave = "qwerty6" ' clave correspondiente al 6º archivo"
            Abrir = True
    '
        Case "Archivo7" 'poner el nombre del 7º archivo, sin extensión
            LaClave = "qwerty7" ' clave correspondiente al 7º archivo"
            Abrir = True
    '
        Case "Archivo8" 'poner el nombre del 8º archivo, sin extensión
            LaClave = "qwerty8" ' clave correspondiente al 8º archivo"
            Abrir = True
    '
        Case "Archivo9" 'poner el nombre del 9º archivo, sin extensión
            LaClave = "qwerty9" ' clave correspondiente al 9º archivo"
            Abrir = True
    '
        Case "Archivo10" 'poner el nombre del 10º archivo, sin extensión
            LaClave = "qwerty10" ' clave correspondiente al 10º archivo"
            Abrir = True
    '
    End Select
    If Abrir Then
        Workbooks.Open DirBusc & LosArchivos, Password:=LaClave, UpdateLinks:=xlNo
        cont = cont + 1
    End If
    LosArchivos = Dir
Loop
ElMensaje = IIf(cont = 0, "NO SE ABRIO NINGUN ARCHIVO", "Se abrieron: " & cont & " archivo" & IIf(cont > 1, "s", ""))
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
Application.StatusBar = False
End Sub

Luego me dirás si te anduvo.

Un abrazo

Fernando

(Buenos Aires, Argentina)

.

Estimado, estuve recién esta mañana con la macro, te muestro donde me indica error

Espero tus comentarios...