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