[英]Import multiple text files into excel
我需要将多个文本文件导入1个Excel工作表。 我尝试了以下代码,但仅完成了我需要的部分工作。 所有文本文件都在同一文件夹中,并且具有相同的名称。 因此,它们是:测试(1),测试(2)等。
目标是:仅在1个excel工作表中导入所有文本文件; 文本文件应水平粘贴:excel中每个文本文件需要1行。 然后,文件内容应以文本格式粘贴。 您能帮我解决这个问题吗?
Sub Files()
Dim myfiles
Dim i As Integer
myfiles = Application.GetOpenFilename(filefilter:="TEXT Files (*.txt), *.txt", MultiSelect:=True)
If Not IsEmpty(myfiles) Then
For i = LBound(myfiles) To UBound(myfiles)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & myfiles(i), Destination:=range("A" & Rows.Count).End(xlUp).Offset(1, 0))
.Name = "test"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(xlGeneralFormat)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next i
Else
MsgBox "No File Selected"
End If
End Sub
这应该为您做。
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim i As Long
Dim cl As Range
Set fso = New FileSystemObject
Set folder = fso.GetFolder("C:\your_path\")
Set cl = ActiveSheet.Cells(1, 1)
Application.ScreenUpdating = False
For Each file In folder.Files
Set FileText = file.OpenAsTextStream(ForReading)
cl.Value = file.Name
i = 1
Do While Not FileText.AtEndOfStream
cl.Offset(i, 0).Value = FileText.ReadLine
i = i + 1
Loop
FileText.Close
Set cl = cl.Offset(0, 1)
Next file
Application.ScreenUpdating = True
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.