Files opened

Checking the names of opened files is necessary in many VBA operations. For many VBA macros it is necessary to open, save, and close many files. Since the file names opened must be unique to each application(Word, Excel, PowerPoint) the VBA macro must check the opened files when opening or "saving as" to prevent abnorminally terminate.

The VBA macro code to list the opened files is similar in the three Microsoft application, Excel, Word and PowerPoint. VBA has a macro variable to indicate the active application. The only difference is one key word in the 'For statement'. Excel uses the key word 'Workbooks', Word uses the key word 'Documents' and PowerPoint uses key word 'Presentations'. To display the opened files is different for each application. I used the three functions: DISPLAY_EXCEL, DISPLAY_WORD AND DISPLAY_POWERPOINT to display each application.

To close these opened files try Close All Temporary Files

VBA Fifth Dimension Macro-List Files Opened

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

Public LIBRARY_NAMES(500), LIBRARY_SIZE
Sub LIST_FILE_OPENED()
    LIBRARY_SIZE = 0
    If InStr(Application.Name, "Excel") Then
       For Each FILE_OPENED In Workbooks
           LIBRARY_SIZE = LIBRARY_SIZE + 1
           LIBRARY_NAMES(LIBRARY_SIZE) = FILE_OPENED.Name
       Next
    End If
    If InStr(Application.Name, "PowerPoint") Then
       For Each FILE_OPENED In Presentations
           LIBRARY_SIZE = LIBRARY_SIZE + 1
           LIBRARY_NAMES(LIBRARY_SIZE) = FILE_OPENED.Name
       Next
    End If
    If InStr(Application.Name, "Word") Then
       For Each FILE_OPENED In Documents
           LIBRARY_SIZE = LIBRARY_SIZE + 1
           LIBRARY_NAMES(LIBRARY_SIZE) = FILE_OPENED.Name
       Next
    End If
' Display the files opened in each application
    HEAD = LIBRARY_SIZE & " Files opened to " & _ 
           Application.Name
    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