8/7/2019 Manejo Listas Archivos

1/4

Sub HyperlinkXLSFiles()Dim lCount As LongApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseApplication.EnableEvents = FalseOn Error Resume Next

With Application.FileSearch

.NewSearch'Change path to suit.LookIn = "C:\MyDocuments\Testings".FileType = msoFileTypeExcelWorkbooks' .Filename = "Book*.xls"

If .Execute > 0 Then 'Workbooks in folderFor lCount = 1 To .FoundFiles.Count 'Loop through all.

ActiveSheet.Hyperlinks.Add Anchor:=Cells(lCount, 1), Address:= _

.FoundFiles(lCount), TextToDisplay:= _Replace(.FoundFiles(lCount), "C:\MyDocuments\Testings\", ""

)

Next lCountEnd IfEnd WithOn Error GoTo 0Application.ScreenUpdating = TrueApplication.DisplayAlerts = TrueApplication.EnableEvents = True

End Sub'---------------------------------------------------------------------------------

Sub RepasarCarpeta()'en este ejemplo sacamos los nombres de los archivos de la carpeta.

'dimensionesDim strArchivoExcel As StringDim strNombreCarpeta As String'carpeta a repasarstrNombreCarpeta = "C:/MisArchivosExcel"'preparar carpetaChDir strNombreCarpetastrArchivoExcel = Dir("*.xls")

'repasamos los archivos de la carpetaDo While strArchivoExcel ""MsgBox strArchivoExcelstrArchivoExcel = DirLoopEnd Sub'--------------------------------------------------------------------'Sub FolderList()'' Example Macro to list the files contained in a folder.'

Dim x As String, MyName As StringDim i As IntegerDim Response As Integer, TotalFiles As Integer

8/7/2019 Manejo Listas Archivos

2/4

On Error Resume Next

Folder:

' Prompt the user for the folder to list.x = InputBox(Prompt:="What folder do you want to list?" & vbCr & vbCr _

& "For example: C:\My Documents", _Default:=Options.DefaultFilePath(wdDocumentsPath))

If x = "" Or x = " " ThenIf MsgBox("Either you did not type a folder name correctly" _

& vbCr & "or you clicked Cancel. Do you want to quit?" _& vbCr & vbCr & _"If you want to type a folder name, click No." & vbCr & _"If you want to quit, click Yes.", vbYesNo) = vbYes Then

Exit SubElse

GoTo Folder

End IfEnd If

' Test if folder exists.If Dir(x, vbDirectory) = "" Then

MsgBox "The folder does not exist. Please try again."GoTo Folder

End If

' Search the specified folder for files' and type the listing in the document.With Application.FileSearch

.NewSearch

.FileType = msoFileTypeOfficeFiles' Change the .FileType to the type of files you are looking for;' for example, the following line finds all files:' .FileType = msoFileTypeAllFiles.LookIn = x.ExecuteTotalFiles = .FoundFiles.CountIf TotalFiles = 0 Then

MsgBox ("There are no files in the folder!" & _"Please type another folder to list.")

GoTo FolderEnd If

' Create a new document for the file listing.Application.Documents.AddActiveDocument.ActiveWindow.View = wdPrintView

' Set tabs.With Selection.ParagraphFormat.TabStops

.Add _Position:=InchesToPoints(3), _Alignment:=wdAlignTabLeft, _Leader:=wdTabLeaderSpaces

.Add _Position:=InchesToPoints(4), _

Alignment:=wdAlignTabLeft, _Leader:=wdTabLeaderSpaces

End With

8/7/2019 Manejo Listas Archivos

3/4

' Type the file list headings.Selection.TypeText "File Listing of the "

With Selection.Font.AllCaps = True.Bold = True

End WithSelection.TypeText xWith Selection.Font

.AllCaps = False

.Bold = FalseEnd WithSelection.TypeText " folder!" & vbLfSelection.Font.Underline = wdUnderlineSingleSelection.TypeText vbLf & "File Name" & vbTab & "File Size" _

& vbTab & "File Date/Time" & vbLf & vbLfSelection.Font.Underline = wdUnderlineNoneFor i = 1 To TotalFiles

MyName = .FoundFiles(i)Selection.TypeText MyName & vbTab & FileLen(MyName) _& vbTab & FileDateTime(MyName) & vbLf

Next i

' Type the total number of files found.Selection.TypeText vbLf & "Total files in folder = " & TotalFiles & _

" files."End With

If MsgBox("Do you want to print this folder list?", vbYesNo)=vbYes ThenApplication.ActiveDocument.PrintOut

End If

If MsgBox("Do you want to list another folder?", vbYesNo)=vbYes ThenGoTo Folder

End If

End Sub'---------------------------------------------

Sub RunCodeOnAllXLSFiles()Dim lCount As LongDim wbResults As WorkbookDim wbCodeBook As Workbook

Application.ScreenUpdating = FalseApplication.DisplayAlerts = FalseApplication.EnableEvents = False

On Error Resume NextSet wbCodeBook = ThisWorkbook

With Application.FileSearch.NewSearch'Change path to suit.LookIn = "C:\MyDocuments\TestResults".FileType = msoFileTypeExcelWorkbooks

'Optional filter with wildcard'.Filename = "Book*.xls"

If .Execute > 0 Then 'Workbooks in folder

8/7/2019 Manejo Listas Archivos

4/4

For lCount = 1 To .FoundFiles.Count 'Loop through all'Open Workbook x and Set a Workbook variable to itSet wbResults = Workbooks.Open(Filename:=.FoundFiles(lCo

unt), UpdateLinks:=0)

'DO YOUR CODE HERE

wbResults.Close SaveChanges:=FalseNext lCount

End IfEnd With

On Error GoTo 0Application.ScreenUpdating = TrueApplication.DisplayAlerts = TrueApplication.EnableEvents = TrueEnd Sub

MsoFileType can be one of these MsoFileType constants

msoFileTypeAllFilesmsoFileTypeBindersmsoFileTypeCalendarItemmsoFileTypeContactItemmsoFileTypeCustommsoFileTypeDatabasesmsoFileTypeDataConnectionFilesmsoFileTypeDesignerFilesmsoFileTypeDocumentImagingFilesmsoFileTypeExcelWorkbooksmsoFileTypeJournalItemmsoFileTypeMailItemmsoFileTypeNoteItem

msoFileTypeOfficeFilesmsoFileTypeOutlookItemsmsoFileTypePhotoDrawFilesmsoFileTypePowerPointPresentationsmsoFileTypeProjectFilesmsoFileTypePublisherFilesmsoFileTypeTaskItemmsoFileTypeTemplatesmsoFileTypeVisioFilesmsoFileTypeWebPages'-----------------------------------------------------------------------'