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