Files in directory

Checking the names of files in the current directory is a necessary in many VBA operations. When a file is saved in a directory that already contains the same file name, confirmation to overwrite the file is requested. A VBA macro may save, close, create, delete, and open many files so it is important to enable the macro to execute without interruptions. At times it may be necessary to allow the user to choose the disposition of a file.

When asking the user to select a file, displaying a list of files in the current directory is user friendly. When the number of files is large, the Forms technique should be used. To select a file using a form, try the Forms document.

Advanced programmers can accommodate the available of data using this technique.

The same macro code is used to get the files in a directory using Excel, Word, or PowerPoint. To display the files is different for each application. I used the three functions: DISPLAY_EXCEL, DISPLAY_WORD AND DISPLAY_POWERPOINT to display each application.

Please Note: In most cases the current direcrory function, CurDir(), needs appending the character "\" to be used by the DIR() function. When the current directory is the drive, "C:\", the current directory function can be used by the DIR() function.

VBA Fifth Dimension Macro-File in Directory

Review the following code, copy it to Excel, Word, or PowerPoint and execute it.

Public LIBRARY_NAMES(500), LIBRARY_SIZE
Sub FILES_IN_DIRECTORY()
    CURRENT_DIRECTORY = CurDir()
    If Right(CURRENT_DIRECTORY, 1) <> "\" Then _
    CURRENT_DIRECTORY = CURRENT_DIRECTORY & "\"
    LIBNAME = Dir(CURRENT_DIRECTORY)
    LIBRARY_SIZE = 0
    Do While LIBNAME <> ""
       LIBRARY_SIZE = LIBRARY_SIZE + 1
       LIBRARY_NAMES(LIBRARY_SIZE) = LIBNAME
       LIBNAME = Dir()
    Loop
    HEAD = "Files in directory " & CURDIR()
    If InStr(Application.Name, "Excel") _
    Then RC = DISPLAY_EXCEL(HEAD)
    If InStr(Application.Name, "Word") _
    Then RC = DISPLAY_WORD(HEAD)
    If InStr(Application.Name, "PowerPoint") _
    Then RC = DISPLAY_POWERPOINT(HEAD)
End Sub
Function DISPLAY_EXCEL(HEAD)
' copy list of file to a new worksheet
     Workbooks.Add
     For II = 1 To LIBRARY_SIZE
         Cells(II, 1) = LIBRARY_NAMES(II)
     Next
     Cells(1, 1).Select
     Selection.Insert Shift:=xlDown
     Cells(1, 1) = HEAD
     Columns("A").EntireColumn.AutoFit
     Cells(1, 1).Select
     ActiveWorkbook.Saved = True
End Function
Function DISPLAY_WORD(HEAD)
' Copy list of files to a new document
    Documents.Add
    Selection.TypeText Text:=HEAD
    Selection.TypeParagraph
    Selection.TypeParagraph
    For II = 1 To LIBRARY_SIZE
        Selection.TypeText Text:=LIBRARY_NAMES(II)
        Selection.TypeParagraph
    Next
    ActiveDocument.Saved = True
End Function
Function DISPLAY_POWERPOINT(HEAD)
' Copy list of files to a new presentation
    For II = 1 To LIBRARY_SIZE
        MSG = MSG & LIBRARY_NAMES(II) & _ 
              Chr$(CharCode:=13)
    Next
    Presentations.Add WithWindow:=msoTrue
    ActiveWindow.View.GotoSlide _
     Index:=ActivePRESENTATION.Slides.Add(Index:=1, _
     Layout:=ppLayoutText).SlideIndex
    ActiveWindow.Selection.SlideRange.Shapes _ 
     ("Rectangle 2").Select
    ActiveWindow.Selection.ShapeRange.TextFrame. _ 
     TextRange.Select
    ActiveWindow.Selection.ShapeRange.TextFrame. _ 
     TextRange.Characters (Start:=1, Length:=0).Select
    ActiveWindow.Selection.TextRange.Text = HEAD
    ActiveWindow.Selection.SlideRange.Shapes _
     ("Rectangle 3").Select
    ActiveWindow.Selection.ShapeRange.TextFrame. _ 
     TextRange.Select
    ActiveWindow.Selection.ShapeRange.TextFrame. _ 
     TextRange.Characters _
     (Start:=1, Length:=0).Select
    ActiveWindow.Selection.TextRange.Text = MSG
    ActivePRESENTATION.Saved = True
End Function