删除不需要的行，同时导入文本文件和分隔数据

我有一个代码，导入记事本数据，以优秀的文件名的新列添加到它。 现在的挑战是，在记事本中，数据的开头和结尾都有不需要的行。

1. 我怎样才能删除？
2. 我们通常会对数据进行分隔，而在将文件导入到excel时不会发生这种情况。

记事本的前五行如下

驱动器Y中的卷没有标签。 卷序列号是3000-0003

Y：\的目录

最后两行如下

0 File(s) 0 bytes 1796 Dir(s) 2,497,977,561,088 bytes free 

数据就像这样12/19/2013 05:27 PM User1

用目前的代码我得到了这样的

Colum 1 = Abc_notepad1.text（textfile name）Column2 = 2013/12/19 05:27用户1

我想要代码删除前五行和最后两行，并输出像这样Column1 = ABC（前3个字母的文本文件名），Column2 = 2013年12月19日下午05:27，Column3 =，Column4 = User1

 Option Explicit Const myPath = "D:\My Data\" Const delim = vbTab Sub MergeMultipleTextFiles() Dim myFile As String 'filename Dim strRecord As String 'record string Dim arrRecord() 'record array Dim fNum As Integer 'free file number Dim RowCounter As Long 'row counter Dim i As Long 'loop variable On Error GoTo errHandler myFile = Dir(myPath & "*.txt") RowCounter = 0 Do While myFile <> "" fNum = FreeFile Open myPath & myFile For Input As #fNum Do While Not EOF(fNum) 'read in the row into the record variable Line Input #fNum, strRecord 'add the filename to the record variable strRecord = myFile & delim & strRecord RowCounter = RowCounter + 1 'resize the record array ReDim Preserve arrRecord(1 To RowCounter) arrRecord(RowCounter) = Split(strRecord, delim) Loop Close #fNum 'get the next file in the directory myFile = Dir() Loop With ThisWorkbook.Sheets("Sheet1").Range("A1") For i = 1 To RowCounter .Offset(i - 1).Resize(, UBound(arrRecord(i)) + 1).Value = arrRecord(i) Next i End With errExit: 'close all open text files Reset Exit Sub errHandler: 'error message goes here Resume errExit End Sub 

Answer 1

Q1 – 绕过前5行：

 For i1 = 1 to 5 Line Input #fNum, strRecord Next i1 

Q2 – 绕过最后2行：

  If InStr(1, strRecord, "File(s)" > 0 then exit Do 

Q3 – 获取列：

  Column1 = Left$(textfilename, 3) Column2 = Left$(data, 19) Column3 = "" Column4 = mid$(data, 21)