A ver si esto te sirve:
Un botón que al pulsarlo abra una ventana en la que puedas seleccionar cualquier plantilla de word, y que una vez seleccionada, la copie a la carpeta Plantillas del directorio donde está tu BD y añada el nombre del archivo a la lista.
Paso 1: creas un nuevo módulo en tu BD (llámalo, por ejemplo mdlArchivos) y le pones este código:
'------------------------------------------------------------------------------------------------
' Función para abrir ventana de diálogo y buscar archivos
'------------------------------------------------------------------------------------------------
Public Function fncBuscaArchivo() As String
On Error GoTo sol_err
Dim fDialog As Office.FileDialog<br class="scayt-misspell" data-scayt_word="Dim" data-scaytid="426" />Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.ButtonName = "Seleccionar"
.Title = "Seleccionar el archivo"
.InitialFileName = Application.CurrentProject.Path
.InitialView = msoFileDialogViewDetails
.Filters.Clear
.Filters.Add "Plantillas de Word", "*.dot"
If .Show = True Then
fncBuscaArchivo = .SelectedItems(1)
Else
'No hacemos nada
End If
End With
Salida:
Exit Function
sol_err:
Call MsgBox "Se ha producido el error: " & Err.Number & " - " & Err.Description, vbInformation + vbOkOnly,"ERROR"
Resume Salida
End Function
Para que esta función te funcione, tienes que registrar la librería "Microsoft Office 12.0 Object Library". Para ello, en el editor de vba vas a Herramientas->Referencias y allí la buscas y le marcas la casilla para registrarla (si no la tienes ya registrada)
Paso 2: Creas un botón en tu formulario, junto al cuadro de lista, y le pones este código, en el evento al hacer click:
On Error GoTo sol_err
Dim miRuta As String
Dim miArchivo As String<br class="scayt-misspell" data-scayt_word="Dim" data-scaytid="614" />Dim fso As Scripting.FileSystemObject
Dim arch As Scripting.File 'arch = archivo
miRuta = Application.CurrentProject.Path & "\Plantillas"
'Creamos la carpeta de la raza
MkDir miRuta
'Asignamos el valor de la variable al archivo que seleccionemos al navegar.
'Para ello utilizamos la llamada a la función buscaArchivo
miArchivo = fncBuscaArchivo()
'Si no seleccionamos ningún archivo, salimos
If IsNull(miArchivo) Or miArchivo = "" Then Exit Sub
'Creamos el objeto fso
Set fso = CreateObject("Scripting.FileSystemObject")
'Obtenemos el archivo de trabajo. Si no existe obtenemos el error 53.
Set arch = fso.GetFile(miArchivo)
'Copiamos el documento a la carpeta "Plantillas"
arch.Copy (miRuta & "\" & arch.Name)
Salida:
'Actualizamos el cuadro de lista (supondré que se llama lstPlantllas)<br class="scayt-misspell" data-scayt_word="Dim" data-scaytid="1423" />Dim misAdjuntos As String
miAdjuntos=Me.lstPlantillas.RowSource & ";" & arch.Name
Me.lstPlantilas.Requery
Exit Sub
sol_err:
Select Case Err.Number
Case 53
Call miMsg("El archivo " & miArchivo & " no existe.", 1)
Case 75
Resume Next
Case Else
Call miMsg("Se ha producido el error " & Err.Number & " - " & Err.Description, 1)
End Select
Resume Salida
Para que este código funcione, tendrás que registrar la biblioteca "Microsoft Scripting Runtime"
El código no lo probé, lo escribí "de cabeza" a partir de un código similar que uso en una de mis BDs. Si hay cualquier error, coméntamelo y miramos de solucionarlo.