我想打开对话框窗口来搜索Excel文件并导入

时间:2017-03-21 17:13:29

标签: vba

以下代码将查找文本文件,但我希望使用当前文件的文件夹位置弹出相同的对话框。我该怎么做?

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

如果fName =" False"然后退出Sub

With Sheets("data export").QueryTables.Add(Connection:="TEXT;" & fName, _
    Destination:=Worksheets("data export").Range("$A$1"))
        .Name = "sample"
        .FieldNames = True
        .RowNumbers = True
        .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 = xlTextQualifierNone
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "" & Chr(10) & ""
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, _
           1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
           1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
           1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
End With

1 个答案:

答案 0 :(得分:0)

您可以使用两种方法在指定路径中搜索Excel文件:

1 - 使用GetOpenFilename并使用ChDir更改路径:

Dim file

'Set current path
ChDir ActiveWorkbook.Path

file = Application.GetOpenFilename("Excel Files, *.xls*")

If file <> False Then
 MsgBox file
End If

2 - 使用FileDialog并设置InitialFileName属性:

Dim file As String, fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
    .InitialFileName = ActiveWorkbook.Path
    .Filters.Clear
    .Filters.Add "Excel files", "*.xls*"
    .AllowMultiSelect = False
    If .Show Then
        file = .SelectedItems(1)
        MsgBox file
    End If
End With

Set fd = Nothing

在这两个例子中,我都过滤了所有excel文件,包括2007及更早版本。