Como puedo copiar múltiples archivos

H o l a:

¿De dónde a dónde quieres copiar los archivos?

¿En dónde tienes la lista de los nombres? ¿En una hoja? ¿En cuál columna? ¿En cuál fila empiezan?

Hola logre hacerlo con este código, pero tengo otra consulta:

Private Sub cmdEXP_Click()
Dim mRuta As String
Dim miSql As String
Dim rst As DAO.Recordset

miSql = "SELECT IDCBaaN,IDDoc FROM TPedido ORDER BY IDCBaaN"

Set rst = CurrentDb.OpenRecordset(miSql)
If rst.RecordCount = 0 Then Exit Sub 'Si no hay registros en la tabla salimos

With rst
.MoveFirst

Do Until .EOF
miArchivo = Nz(rst("IDDoc"))
mRuta = Application.CurrentProject.Path & "\Documentos\Datos\" & Nz(rst("IDCBaaN")) & "\"
miRuta = mRuta
miArchivo = miRuta & miArchivo & ".pdf"

.MoveNext

miRuta = fncSelectCarpeta()
Set fso = CreateObject("Scripting.FileSystemObject")
Set arch = fso.GetFile(miArchivo)
arch.Copy (miRuta & "\" & arch.Name)
Loop
End With

rst.Close
Set rst = Nothing

End Sub

Pero hay algo que no entiendo y me molesta, es que cada ves que hace el ciclo pregunta nuevamente donde exportar, quisiera que pregunte una sola vez o que cree una carpeta con un nombre fijo como "archivos exportados"

En tu macro tienes esta línea:

MiRuta = fncSelectCarpeta()

Mueve esa línea al principio de tu macro, por ejemplo la puedes poner después de esta línea:

Dim rst As DAO.Recordset

Ya  probé a esa opción, también hice prueba y error casi en todas las posiciones por eso me encuentro un poco perdido yo pensaba que iba a funcionar ahí.

quiero cambiar la función de:

fncSelectCarpeta()
Public Function fncSelectCarpeta() As String
On Error GoTo sol_err
Set Wscript = CreateObject("WScript.Shell")
miRuta = Wscript.SpecialFolders("Desktop")
'miRuta = Application.CurrentProject.Path
'miRuta = "C:\Users\\Desktop"
'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 & " en la función fncSelectCarpeta.", vbInformation + vbOKOnly, "ERROR"
    Resume Salida
End Function

quiero que se copien en el escritorio y dentro de una carpeta que creo en la acción del botón pero no logro que se copien los archivos hasta ahora tengo esto:

Private Sub cmdEXP_Click()
On Error GoTo sol_err
Dim mRuta As String
Dim mRuta1 As String
Dim miSql As String
Dim rst As DAO.Recordset
Set Wscript = CreateObject("WScript.Shell")
miRutaC = Wscript.SpecialFolders("Desktop")
MkDir miRutaC & "\Archivos Exportados"
 miSql = "SELECT IDCBaaN,IDDoc FROM TPedido ORDER BY IDCBaaN"
 Set rst = CurrentDb.OpenRecordset(miSql)
 If rst.RecordCount = 0 Then Exit Sub
 With rst
 .MoveFirst
 Do Until .EOF
 miArchivo = Nz(rst("IDDoc"))
 mRuta = Application.CurrentProject.Path & "\Documentos\Datos\" & Nz(rst("IDCBaaN")) & "\"
 miArchivo = miRuta & miArchivo & ".pdf"
mRuta1 = miRutaC & "\Archivos Exportados\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set arch = fso.GetFile(miArchivo)
arch.Copy (mRuta1 & "\" & arch.Name)
 .MoveNext
 Loop
 End With
 rst.Close
 Set rst = Nothing
Salida:
    Exit Sub
sol_err:
    Select Case Err.Number
        Case 53  'Archivo no encontrado
            'Resume Siguiente
         Case 70
            'MsgBox "Se ha producido el error " & Err.Number & " - " & Err.Description, vbInformation + vbOKOnly, "ERROR"
    End Select
    Resume Salida
End Sub

No puedo probar la macro, hay algunas funciones que no tengo.

En dónde lo estás haciendo, ¿en VB o en Access o en VBA de Excel?

Hola muchas gracias por tu interés , ya logre resolverlo pero necesito una mano con esto, primero el código:

Private Sub cmdEXP_Click()
On Error GoTo sol_err
Dim miSql As String
Dim rst As DAO.Recordset
Set Wscript = CreateObject("WScript.Shell")
miRutaC = Wscript.SpecialFolders("Desktop")
 miSql = "SELECT IDCBaaN,IDDoc FROM TPedido ORDER BY IDCBaaN"
 Set rst = CurrentDb.OpenRecordset(miSql)
 If rst.RecordCount = 0 Then 'Exit Sub 
 MsgBox "No existen archivos a exportar", vbInformation + vbOKOnly, "ERROR"
 Exit Sub
 End If
 MkDir miRutaC & "\Archivos Exportados"
 With rst
 .MoveFirst
 Do Until .EOF
 miArchivo = Nz(rst("IDDoc"))
        If miArchivo = "" Then
        .MoveNext
        End If
        miArchivo = Nz(rst("IDDoc"))
 miRuta = Application.CurrentProject.Path & "\Documentos\Datos\" & Nz(rst("IDCBaaN")) & "\"
 miArchivo = miRuta & miArchivo & ".pdf"
miRuta = miRutaC & "\Archivos Exportados"
Set fso = CreateObject("Scripting.FileSystemObject")
Set arch = fso.GetFile(miArchivo)
arch.Copy (miRuta & "\" & arch.Name)
Siguiente:
.MoveNext
 Loop
 End With
 'Cerramos conexiones y liberamos memoria
 rst.Close
 Set rst = Nothing
Salida:
    Exit Sub
sol_err:
    Select Case Err.Number
        Case 53  'Archivo no encontrado
    Resume Siguiente
        Case 75
    MsgBox "Carpeta de adjuntos existente, Eliminar antes de exportar otro pedido", vbInformation + vbOKOnly, "ERROR"
    End Select
    Resume Salida

Lo que hace esto es componer la ruta y el nombre del archivo con datos de la Tabla pedidos y hacer una copia de estos documentos(.pdf) en una carpeta que se crea en el escritorio con el nombre "Archivos Exportados"

hasta ahí esta funcional ahora yo quiero agregarle 2 casillas de check a mi informe donde la 1ª sea exporta.pdf,  la 2ª exporta.dxf  o .rar ¿sera posible?

A tener en cuenta que los nombre de los archivos son el mismo solo cambia la extensión.