text split near line end

[daviduk001]

I have created VBA import multiple text files into the same sheet and put each file text into one cell
but I found a problem with excel limited to 32,767 characters in one cell.
Then I split files when characters are over the limit and put it into the next row.

Now I have another issue there is the problem is some phrase is split.
I don't want to split the word, I want to split its end of the line of the phrase before over the max character.
Does anyone help with this?

if you required big text files to test please go here and you can download text files

An "Attic" Philosopher, entire by Emile Souvestre - Full Text Free Book

and this is my current code

Dim i As Integer

Sub ImportTextFiles()

i = 2
SelectMultipleFiles

MsgBox ("Execution Completed...!")

End Sub

Function SelectMultipleFiles()
    Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
        .AllowMultiSelect = True
        .Title = "Please select the files"
        .Filters.Clear
        .Filters.Add "All supported files", "*.txt"
        .Filters.Add "Text Files", "*.txt"
        
        If .Show = True Then
            Dim fPath As Variant
            For Each fPath In .SelectedItems
                ImportFile fPath
            Next
        End If
    End With
End Function

Function ImportFile(Path)

    Dim my_file As Integer
    Dim file_name As String
    Dim allText As String
    Dim fso As New Scripting.FileSystemObject
   
    file_name = Path
    'my_file = FreeFile()
    Open file_name For Binary As #1
    allText = Space$(LOF(1))
    Get #1, , allText
    Close #1

    Dim allTxtArr
    
    allTxtArr = SplitString(allText, 32700)
    
    Dim item As Variant
    Dim fileNameWithoutExt As String
    Dim idx As Integer
    
    fileNameWithoutExt = fso.GetBaseName(file_name)
    idx = 1
    
    For Each item In allTxtArr
        
        item = Trim(item)
        If (item <> Empty) Then
            Cells(i, 1).Value = fileNameWithoutExt & idx
            Cells(i, 2).Value = Trim(item)
            i = i + 1
            idx = idx + 1
        End If
    Next
       
    allText = ""
    allTxtArr = Null
    
    
End Function

Public Function SplitString(ByVal str As String, ByVal numOfChar As Long) As String()
    Dim sArr() As String
    Dim nCount As Long
    ReDim sArr(Len(str) \ numOfChar)
    Do While Len(str)
        sArr(nCount) = Left$(str, numOfChar)
        str = Mid$(str, numOfChar + 1)
        nCount = nCount + 1
    Loop
    SplitString = sArr
End Function

 

[severynm]

So you're looking to split to the next line at the first line break after some arbitrary cut off at like 32750? What if you go to that index, find the index of the next line break Char(10), and then split there. Something like:

idx = Application.WorksheetFunction.Search(Chr(10), textstring, 35700)

 

[daviduk001]

Thanks for your comment but its not works for my issue
As I don't want to split word or phrase by limited 32700 characters
for example "Excel" this word split like this
E
xel

 

[Akuini]

Hi @daviduk001
Welcome to the Forum
This is an example on how to split a string into multiple parts, with 2 criteria:
1. certain maximum character length (in this example n = 300)
2. split in the end of line.

Note: I populate the string from a cell not from a file just to make it easier to test.

Sub a1159532a()
'https://www.mrexcel.com/board/threads/text-split-near-line-end.1159532/#post-5626229
Dim k As Long, n As Long, a As Long
Dim tx As String
Dim va

tx = Range("A1").Value
n = 300 'max character

ReDim va(1 To 100000, 1 To 1)
Do

    a = InStrRev(Left(tx, n), vbLf)
    If a = 0 Then Exit Do
    k = k + 1
    va(k, 1) = Left(tx, a - 1)
    tx = Mid(tx, a + 1)

Loop While Len(tx) > n

If Len(tx) > 0 Then k = k + 1: va(k, 1) = tx

Range("C1").Resize(k, 1) = va

End Sub

I put this string in A1 then ran the code

Book1
	A
1	Of the latter class, though little known outside of France, is Emile Souvestre, who was born in Morlaix, April 15, 1806, and died at Paris July 5, 1854. He was the son of a civil engineer, was educated at the college of Pontivy, and intended to follow his father's career by entering the Polytechnic School. His father, however, died in 1823, and Souvestre matriculated as a law-student at Rennes. But the young student soon devoted himself entirely to literature. His first essay, a tragedy, 'Le Siege de Missolonghi' (1828), was a pronounced failure. Disheartened and disgusted he left Paris and established himself first as a lawyer in Morlaix. Then he became proprietor of a newspaper, and was afterward appointed a professor in Brest and in Mulhouse. In 1836 he contributed
Sheet1

Result

Book1
	C
1	Of the latter class, though little known outside of France, is Emile Souvestre, who was born in Morlaix, April 15, 1806, and died at Paris July 5, 1854. He was the son of a civil engineer, was educated at the college of Pontivy, and intended to follow his father's career by
2	entering the Polytechnic School. His father, however, died in 1823, and Souvestre matriculated as a law-student at Rennes. But the young student soon devoted himself entirely to literature. His first essay, a tragedy, 'Le Siege de Missolonghi' (1828), was a pronounced failure. Disheartened
3	and disgusted he left Paris and established himself first as a lawyer in Morlaix. Then he became proprietor of a newspaper, and was afterward appointed a professor in Brest and in Mulhouse. In 1836 he contributed
Sheet1

 

[daviduk001]

Dear Akuini
Thanks for your comment but this also not helpful for my case
because texts read from the file not a cell in excel sheet

 

[Akuini]

because texts read from the file not a cell in excel sheet

I know that. What I mean is my code can be amended to get the text from a file. Basically you need to populate the text to variable "tx", it doesn't matter the text comes from a range or a file. And change n = 300 to suit.

 

[daviduk001]

Dar Akuini
Thanks for your reply I already tried it with your code and changed the variable with "tx" but not working.
Can you please upload the full code?
Thank you

 

[Akuini]

I don't quite understand your code, but try replacing "Public Function SplitString" with this:

Public Function SplitString(ByVal tx As String, ByVal xz As Long) As String()
'https://www.mrexcel.com/board/threads/text-split-near-line-end.1159532/
Dim g As Long, x As Long
Dim sArr() As String
ReDim sArr(0 To 100000)

        Do
            x = InStrRev(tx, vbLf, xz, vbTextCompare)
            
            If x = 0 Then sArr(g) = tx: Exit Do
                        
            sArr(g) = Left(tx, x - 1)
            tx = Mid(tx, x + 1)
            
            g = g + 1
        Loop Until Len(tx) = 0
    
ReDim Preserve sArr(0 To g)
SplitString = sArr
End Function

 

[daviduk001]

Thank you for your help
Now it's working perfectly! and I solve issue this

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.