如何使用 VBA 导入 .txt 文件并将导入的 .txt 文件名添加到 Excel 工作表的单独单元格中答案

【问题标题】：How to Import .txt file and also add the .txt file name being imported in a seperate cell in a worksheet in Excel using VBA如何使用 VBA 导入 .txt 文件并将导入的 .txt 文件名添加到 Excel 工作表的单独单元格中
【发布时间】：2019-05-10 20:17:04
【问题描述】：

我正在寻找一种将 .txt 文件导入 Excel 工作表的方法，并将文件名（比如 P06_113.txt）添加到同一工作表内的单独单元格中。

我寻找一个在导入时提取文件名的函数，然后将文件名复制并粘贴到给定的单元格中。

Sub Import()
Dim myFile As Variant
myFile = Application.GetOpenFilename(FileFilter:="TXT Files, *.txt", 
Title:="Select File To Be Opened")
Do While myFile <> vbNullString
If myFile = False Then Exit Sub

With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & myFile _
    , Destination:=Range("$A$1"))
    .Name = myFile
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 850
    .TextFileStartRow = 1
    .TextFileParseType = xlFixedWidth
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1)
    .TextFileFixedColumnWidths = Array(8, 4, 6)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With   
End Sub

预期的结果是：

例子

一年的数据

数据 b 年

数据c年

“文件名.txt”

【问题讨论】：

可以从myFile获取文件名。 Stack Overflow 上有示例从完整路径中提取文件名。

标签： excel vba import

【解决方案1】：

这是我通过FileDialog 对象导入文件的方法，也是一种“防呆”方法，允许仅导入.txt 文件，以及是否要保留以前的数据

Public Function get_file(ByVal format as String) As String
    'File Dialogue picker by Rawrplus

    Dim dia As FileDialog
    Dim res As String

prompt:
    Set dia = Application.FileDialog(msoFileDialogFilePicker)
    With dia
        .Title = "CHoose a file"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then
            GoTo esc_bridge
        End If

        res = .SelectedItems(1)
    End With

esc_bridge:
    If Not Right(res, Len(format)) = format Then
        MsgBox "Please select a ." & format & " file!"
        GoTo prompt
    End If

    get_file = res
    Set dia = Nothing

End Function

打印.txt文件内容的功能：

Public Sub read_file(ByVal path As String, ByVal ws as Worksheet)
    Open path For Input As #1
    Dim i As Integer
    Dim data As String

    If MsgBox("Keep previous data?", vbQuestion + vbYesNo, "Please decide") = vbYes Then
        i = ws.Cells(Rows.count, 1).End(xlUp).Row + 1
    Else
        i = ws.Cells(Rows.count, 1).End(xlUp).Row + 1
        ws.Rows("1:" & i).EntireRow.Delete
        i = 1
    End If

    Do Until EOF(1)
        Line Input #1, data
        ws.Cells(i, 1) = data
        i = i + 1
    Loop

    Close #1
End Sub

所以调用看起来像这样：

Private Sub import_file()
  Dim ws as Worksheet: Set ws = Sheets("Paste data to this sheet") 'change me
  Dim path as String: path = get_file("txt")
  read_file path, ws
End Sub

【讨论】：