Excel 一次导入2个文本文件

我想通过vba一次将2个txt文件导入excel。目前，我只能导入1个txt文件。 我希望用户能够只选择2个文件导入的能力

Sub ImportFiles()

    'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    Dim path As String
    Dim filename As String
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
    With fd
    
        'Set the initial path to the C:\ drive.
        .InitialFileName = ActiveWorkbook.path
        'Add a filter that includes  the list.
        .Filters.Clear
        .Filters.Add "Text Files", "*.txt", 1                                                   
        'The user pressed the button.
        If .Show = -1 Then
        
            For Each vrtSelectedItem In .SelectedItems
                path = Left(vrtSelectedItem, InStrRev(vrtSelectedItem, "\"))
                filename = Right(vrtSelectedItem, Len(vrtSelectedItem) - InStrRev(vrtSelectedItem, "\"))
               
                 Call Importfile(path, filename)

            Next vrtSelectedItem
        Else
        End If
    End With

    Set fd = Nothing

End Sub


Sub Importfile(path As String, filename As String)
    Sheets.Add(After:=Sheets("Sheet1")).Name = "Data"
    On Error Resume Next
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & path & filename, Destination:=Range("$A$1"))
        .Name = filename
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = False
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileOtherDelimiter = vbTab
        .TextFileDecimalSeparator = "."
        .TextFileThousandsSeparator = " "
        .Refresh BackgroundQuery:=False
    End With
End Sub

我知道我需要使用一个循环来循环它，以选择要导入的2个文件。但是我该怎么做呢？

在网上你会发现

Sub UseFileDialogOpen()
 
    Dim lngCount As Long
 
    ' Open the file dialog
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
 
        ' Display paths of each file selected
        For lngCount = 1 To .SelectedItems.Count
            MsgBox .SelectedItems(lngCount)
        Next lngCount
 
    End With
 
End Sub

因此，您似乎只需要将.count属性添加到.SelectedItems。 也许您需要将.AllowMultiSelect调整为true，以便可以在FilterDialog中一次选择多个文件

Sub ImportFiles()

    'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    Dim path As String
    Dim filename As String
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
    With fd
        'Set the initial path to the C:\ drive.
        .AllowMultiSelect = True
        .InitialFileName = ActiveWorkbook.path
        'Add a filter that includes  the list.
        .Filters.Clear
        .Filters.Add "Text Files", "*.txt", 1                                                   
        'The user pressed the button.
        If .Show = -1 Then
        
            For lngCount = 1 To .SelectedItems.Count
                path = Left(.SelectedItems(lngCount), InStrRev(.SelectedItems(Count), "\"))
                filename = Right(.SelectedItems(Count), Len(.SelectedItems(Count)) - InStrRev(.SelectedItems(Count), "\"))
               
                 Call Importfile(path, filename)

            Next lngCount
        Else
        End If
    End With

    Set fd = Nothing

End Sub

---

您需要允许用户选择多个文件，您可以通过在文件对话框中添加AllowMultiSelect选项来实现

Sub ImportFiles()

    'Declare a variable as a FileDialog object.
    Dim fd As FileDialog
    Dim path As String
    Dim filename As String
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
    With fd
        .AllowMultiSelect = True
        'Set the initial path to the C:\ drive.
        .InitialFileName = ActiveWorkbook.path
        'Add a filter that includes  the list.
        .Filters.Clear
        .Filters.Add "Text Files", "*.txt", 1                                                   
        'The user pressed the button.
        If .Show = -1 Then
        
            For Each vrtSelectedItem In .SelectedItems
                path = Left(vrtSelectedItem, InStrRev(vrtSelectedItem, "\"))
                filename = Right(vrtSelectedItem, Len(vrtSelectedItem) - InStrRev(vrtSelectedItem, "\"))
               
                 Call Importfile(path, filename)

            Next vrtSelectedItem
        Else
        End If
    End With

    Set fd = Nothing

End Sub

---

嗨，我试着导入一个文件。但是我在这一行“path=left…”中收到一个错误，它提示我一个错误5。哦，对不起，这是我脑子里想出来的，所以我没有用你的代码测试它。这很有效，谢谢！