I have ptf files in one folder and want to insert all of them at the same time always after last row. Next example shows what I've written, but it doesn't work, Could anybody help please?



Sub InsertptfFiles()

'trying to import all files in one sheet

Dim fName As String, lastrow As Long

fName = Application.GetOpenFilename("Text Files (*.ptf), *.ptf", MultiSelect:=True)

If fName = "False" Then Exit Sub

lastrow = Range("B" & Rows.Count).End(xlUp).Row + 1

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
Destination:=Range("A" & lastrow))
.name = "sample"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 17
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

End Sub