尝试为FileDialog定义设置路径

时间:2017-12-15 08:28:11

标签: excel vba

您好我在尝试使用以下代码使用查询表通过.txt导入FileDialog文件。我的问题是我无法定义FileDialog带来的路径,它只是打开了通用"Documents\Excel folder"。如何定义此对话框打开的路径?任何帮助将不胜感激!

Sub ImportTextFile()
Dim fName As FileDialog, LastRow As Long

Set fName = Application.FileDialog(msoFileDialogOpen)
fName.InitialFileName = "\\olscmesf003\gcm_emea\TCU_REPORTS\APPS\Reports\Regional\Pointsec for PC  Web RH\2017\"
If fName = "False" Then Exit Sub

LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
        Destination:=Range("A" & LastRow))
            .Name = "sample"
            .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 = xlTextQualifierNone
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .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
End Sub

1 个答案:

答案 0 :(得分:1)

我认为您的错误是因为您没有在查询连接字符串中指定文件和文件夹路径

引用here语法是.....

With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Test.TXT", Destination:=Range("$A$1"))
        ... Blah
End With

你有

Connection:="TEXT;" & fName其中fName是

"\\olscmesf003\gcm_emea\TCU_REPORTS\APPS\Reports\Regional\Pointsec for PC  Web RH\2017\" 

即。没有关联的文件名。

如果使用filedialog对象 Application.FileDialog(msoFileDialogFilePicker)您可以收集所选文件并将其放入变量中。

E.g。 FileName = .SelectedItems(1)

Sub Main()
'https://analysistabs.com/excel-vba/folders-file-handling/ ''example layout taken from here.

    Dim fileName As String
    Dim fileChosen As Long
    Dim lastRow As Long

    'Declare a variable as a FileDialog object.
    Dim fd As FileDialog

    'Create a FileDialog object as a File Picker dialog box. This allows you to capture the selected item.
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    'Use a With...End With block to reference the FileDialog object.
    With fd

         'Set initial folder to open to
        .InitialFileName = "\\olscmesf003\gcm_emea\TCU_REPORTS\APPS\Reports\Regional\Pointsec for PC  Web RH\2017\"

        'Set the Folder View
        .InitialView = msoFileDialogViewSmallIcons

        'Set the caption of the dialog box,
        .Title = "Please select a WebRHLog file"

        'Allow only one file to be selected
        .AllowMultiSelect = False

        'Set the filter
        .Filters.Clear
        .Filters.Add "Text files", "*.txt"   'Not sure anything other than extension can be used as filter

        fileChosen = .Show

        If fileChosen <> -1 Then

           'No file selected/ Clicked on CANCEL
            MsgBox "No file selected"
            Exit Sub

        Else
           'capture name and complete path of file chosen
           fileName = .SelectedItems(1)

        End If

    End With

    lastRow = Range("A" & Rows.Count).End(xlUp).Row + 1

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fileName, _
        Destination:=Range("A" & lastRow))
            .Name = "sample"
            .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 = xlTextQualifierNone
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .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
End Sub