Macro que abra todos los archivos de excele de una carpeta

Desde el editor de vbasic (alt+f11), inserta un modulo (NO modulo de clase, solo un modulo), alli pegas esto:

Sub abrir()
Dim midir As String
ChDir "c:\"
midir = InputBox("Path de archivos", "Abrir Libros", "c:\prueba\")
If Len(Trim(midir)) = 0 Then Exit Sub
ChDir midir
'4c7569735f50
Workbooks.Open midir & Dir(midir, vbArchive)
Do Until Err.Number <> 0
On Error Resume Next
Workbooks.Open midir & Dir
DoEvents
Loop
MsgBox "Terminado", vbInformation
End Sub

Grabas y ya esta. El macro se llama "abrir", al ejecutarlo se te preguntara el path de la carpeta en donde estan los archivos... abrira solo los del path ( no las subcarpetas).

El problema es que es lo mismo que abrirlo manual ya que el problema es que en la macro que me menciona tengo que meterle el path del archivo y no me abre mas que un archivo

No,. Lo que te esta pidiendo es el path de la carpeta que contiene los archivos, no el path del archivo, es decir

c:\carpeta\archivo.xls

Estaria mal

Es solo

c:\carpeta\

Asi abre todos los archivos de esa carpeta ( no asi de las subcarpetas), si en esa carpeta tienes solo 1 archivo, pues abrira solo ese.

lo que pasa que la corrí pero solamente me abre el primer archivo los demás no al parecer es por que no se lleva un ciclo que siga abriendo con el código SINO QUE EL CICLO DO UNTIL ES SOLO SI EXISTIERA EL ERROR

A mi me funciona bien asi, pero si gustas cambia el do por un while o bioen prueba un for

lo que puse fue lo siguiente:

Dim archivo As String
Dim j As Integer
j = 1
ChDir c:\
FolderName = FolderName & \
MsgBox FolderName, vbInformation
If Len(Trim(FolderName)) = 0 Then Exit Sub
ChDir FolderName
Workbooks.Open FolderName & Dir( *.xlsx , vbArchive)
MsgBox FolderName & ActiveWorkbook.Name, vbInformation
archivo = ActiveWorkbook.Name
Do While archivo <>
'impresión en dormato pdf
Worksheets.Select
j = Len(ActiveWorkbook.Name) 'conocer la longitud del nombre incluye la extensión
Name = & Left(ActiveWorkbook.Name, j - 4) &
ruta = ActiveWorkbook.path & \ & Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ruta, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
'abrir el siguiente libro en la misma path de la carpeta
Workbooks.Close
Workbooks.Open FolderName & Dir
On Error GoTo salir
archivo = ActiveWorkbook.Name
Do Until Err.Number <> 0
On Error Resume Next
Workbooks.Open FolderName & Dir
MsgBox FolderName & Dir, vbInformation
DoEvents
Loop
Loop

esto es para poder respaldar lo que hago en el trabajo pero al momento de abrirlos si me guarda varios como pdf pero unos se los salata ademas de que cuando ya no encuentra mas archivos en excel no me salta el error y se queda el bucle trabado no encuentro como saltarme ese error

Bueno eso es tu macro, ¿pero probaste la que te indico como sub individual?, a mi me corre perfecto en v 2007., ¿No veo por que si manejas la misma version no corra igual en tu equipo?.

si manejo el 2007 pero solamente me abre el primer archivo no entiendo el por que u.u mi macro completa quedo asi pero igual no encuentro como salatar el error cuando ya abrió todo el archivo de excel

Private Type BROWSEINFO ' used by the function GetFolderName
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib shell32.dll _
Alias SHGetPathFromIDListA (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib shell32.dll _
Alias SHBrowseForFolderA (lpBrowseInfo As BROWSEINFO) As Long
Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = Select a folder.
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName =
End If
End Function
Sub TestGetFolderName()
Dim FolderName As String
FolderName = GetFolderName( Select a folder )
If FolderName = Then
MsgBox No seleccionaste una carpeta.
Else
MsgBox FolderName
End If
MsgBox Terminado , vbInformation
Dim archivo As String
Dim j As Integer
j = 1
ChDir c:\
FolderName = FolderName & \
MsgBox FolderName, vbInformation
If Len(Trim(FolderName)) = 0 Then Exit Sub
ChDir FolderName
Workbooks.Open FolderName & Dir( *.xlsx , vbArchive)
MsgBox FolderName & ActiveWorkbook.Name, vbInformation
archivo = ActiveWorkbook.Name
Do While archivo <>
'impresión en dormato pdf
Worksheets.Select
j = Len(ActiveWorkbook.Name) 'conocer la longitud del nombre incluye la extensión
Name = & Left(ActiveWorkbook.Name, j - 4) &
ruta = ActiveWorkbook.path & \ & Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ruta, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
'abrir el siguiente libro en la misma path de la carpeta
Workbooks.Close
Workbooks.Open FolderName & Dir
On Error GoTo salir
archivo = ActiveWorkbook.Name
Do Until Err.Number <> 0
On Error Resume Next
Workbooks.Open FolderName & Dir
MsgBox FolderName & Dir, vbInformation
DoEvents
Loop
Loop
salir:
End Sub

en esta combine información que usted me proporciono con otra que encontré creo que en el mismo foro el cual abre busca la carpeta, si pudiera encontrar el como saltar el bucle me seria de gran ayuda ademas si usted puede correrla y verificar que le guarde en pdf todos sus archivos de excel ya que a mi me salta unos y otros si me los guarda

disculpe si esta un poco extenso