Using the GetOpenFilename Method in Windows

To add the GetOpenFilename method to Excel for Windows Add a standard module to the Microsoft Visual Basic for Applications (VBA) project in your workbook. Type Alt+F11 to open the Visual Basic Editor, click Insert, and then click Module. Paste or type the following macro into the module.
Sub Select_File_Or_Files_Windows()
    Dim SaveDriveDir As String
    Dim MyPath As String
    Dim Fname As Variant
    Dim N As Long
    Dim FnameInLoop As String
    Dim mybook As Workbook

    ' Save the current directory.
    SaveDriveDir = CurDir

    ' Set the path to the folder that you want to open.
    MyPath = Application.DefaultFilePath

    ' You can also use a fixed path.
    'MyPath = "C:\Users\Ron de Bruin\Test"

    ' Change drive/directory to MyPath.
    ChDrive MyPath
    ChDir MyPath

    ' Open GetOpenFilename with the file filters.
    Fname = Application.GetOpenFilename( _
            FileFilter:="Excel Files (*.xls), *.xlsx", _
            Title:="Select a file or files", _

    ' Perform some action with the files you selected.
    If IsArray(Fname) Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        For N = LBound(Fname) To UBound(Fname)

            ' Get only the file name and test to see if it is open.
            FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
            If bIsBookOpen(FnameInLoop) = False Then

                Set mybook = Nothing
                On Error Resume Next
                Set mybook = Workbooks.Open(Fname(N))
                On Error GoTo 0

                If Not mybook Is Nothing Then
                    MsgBox "You opened this file : " & Fname(N) & vbNewLine & _
                           "And after you press OK, it will be closed" & vbNewLine & _
                           "without saving. You can replace this line with your own code."
                    mybook.Close SaveChanges:=False
                End If
                MsgBox "We skipped this file : " & Fname(N) & " because it is already open."
            End If
        Next N
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If

    ' Change drive/directory back to SaveDriveDir.
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
End Sub

Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Contributed by Rob Bovey
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function

When you want to add more filters, you can use the following code in the macro to filter on .xls and .csv files.
    Fname = Application.GetOpenFilename( _
            FileFilter:="XLS Files (*.xls),*.xls,CSV Files (*.csv),*.csv", _
            Title:="Select a file or files", _

Type Alt +Q to close the Visual Basic Editor. Type Alt + F8 to open the macro dialog box and run the macro.

Đăng nhận xét

0 Nhận xét