Hi, stefanoste78!
It's due to different types (origin or source) of .txt files. Text files have an attribute called origin or source which indicates which alphabet (set of characters) has to be used to properly open it. The first file had 1252 (Windows ANSI) and the last 65001 (Unicode UTF-8). And I don't know any way of retrieving it to be used as you require here, so if you have files that you want to process in the same pass I'm afraid you're in trouble.
Regards!
good morning
The solution to the problem ... transform the cell contents into text to exclude anything from excel and 65001 UTF8 encoding.
The problem remains that on 247 files only opens 163, it will be tied to the ram.
Should I divide the folder into three but then could I join them by getting the result I set for?
See you soon
Option Explicit
Sub ImportTextFileTabSeparatedNewSheets()
' constants
' declarations
Dim sPath As String, sFile As String, sName As String
Dim I As Integer, A As String
' start
sPath = ThisWorkbook.Path
sFile = Dir(sPath & "\*.txt")
With ThisWorkbook
Worksheets(.Worksheets.Count).Activate
End With
' process
Do Until sFile = ""
' worksheet
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
On Error Resume Next
sName = Left(sFile, InStr(sFile, ".") - 1)
ActiveSheet.Name = sName
On Error GoTo 0
' text file
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPath & "\" & sFile, Destination:=Range("$A$2"))
.Name = sName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform =
65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1,
2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables
.Item(.Count).Delete
End With
' titles
I = 1
With ActiveSheet
Do While Worksheets(1).Cells(2, I + 4) <> ""
.Cells(1, I) = Worksheets(1).Cells(2, I + 4)
I = I + 1
Loop
End With
ActiveSheet.Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
' link
With Worksheets(1)
.Activate
I = .Cells(1, 1).End(xlDown).End(xlDown).End(xlUp).Row + 1
.Cells(I, 1).Value = sName
.Cells(I, 2).Select
.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & sName & "'!A1", TextToDisplay:=sName
End With
' cycle
sFile = Dir()
Loop
' end
ThisWorkbook.Worksheets(1).Activate
Range("A1").Select
Beep
End Sub