如何导入.txt文件以及如何使用VBA在Excel的工作表的单独单元格中添加要导入的.txt文件名

时间:2019-05-10 20:17:05

标签: excel vba import

我正在寻找一种将.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年

“ Filename.txt”

1 个答案:

答案 0 :(得分:-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