Excel VBA: Use getOpenFilename to open folder AND files

29.4k Views Asked by At

I want to use this routine Application.GetOpenFilename to open either a *.txt file OR a whole folder. Is this somehow possible?
E.g. if no file/folder is selected, the parent's folder path is returned, otherwise the selected filename?

Example: Let's assume I have a file called "test.txt" in the path C:\folder1\folder2\test.txt. Now I am lazy when searching files and select C:\folder1 (the "parent folder"). My program now searches within the subfolders for test.txt. But sometimes I am not lazy and I want to select the specific file test.txt

I am searching for one user friendly dialog to handle both: open a folder (and return the folder path only) and open a file (and return the file path)

2

There are 2 best solutions below

1
On

By parent I assume you mean the file from which the VBA is called. If not you should be able to adjust the below pretty easilly.

Sub getFileorFolder()

fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If fileToOpen = False Then fileToOpen = ThisWorkbook.Path

MsgBox "File is " & fileToOpen

End Sub
0
On

I have a better way of opening text files, but utilizing one of the answers above.

Sub ImportTextFile()
'better method to retrieving Data from txt.
If Not Range("A2").Value = "" Then
MsgBox "Clear Data First"
Sheets("Input DATA").Select
Exit Sub
End If

fileToOpen = application.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen = False Then fileToOpen = ThisWorkbook.Path
MsgBox "File is " & fileToOpen

    With ActiveSheet.QueryTables.Add(connection:= _
        "TEXT;" + fileToOpen, Destination:=Range("$A$2"))
        '.name = "All"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
Call RemoveEmptyRows
End Sub

Sub RemoveEmptyRows()
On Error Resume Next
Range("A2:A5000").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Resume:
Range("A2").Select
End Sub