windows - Excel VBA：使用 getOpenFilename 打开文件夹和文件

Question

我想使用此例程Application.GetOpenFilename打开*.txt文件或整个文件夹。这有可能吗？
例如，如果没有选择文件/文件夹，则返回父文件夹路径，否则返回所选文件名？

示例：假设我有一个名为"test.txt"path的文件C:\folder1\folder2\test.txt。现在我在搜索文件并选择C:\folder1（“父文件夹”）时很懒惰。我的程序现在在子文件夹中搜索test.txt. 但有时我并不懒惰，我想选择特定的文件test.txt

我正在寻找一个用户友好的对话框来处理两者：打开一个文件夹（并仅返回文件夹路径）并打开一个文件（并返回文件路径）

Answer 1

parent我假设您的意思是调用 VBA 的文件。如果没有，您应该能够很容易地调整以下内容。

Sub getFileorFolder()

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

If fileToOpen = False Then fileToOpen = ThisWorkbook.Path

MsgBox "File is " & fileToOpen

End Sub

Answer 2

我有一种更好的打开文本文件的方法，但使用了上面的答案之一。

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