Split Copied Text Into Remaining Cells Once Cell Character Limit Has Been Reached or Maxed Out

[MelodyCosta]

Hi Everyone:

I am looking for a little bit of help. I have looked through the threads and dont see any thing that answers my question fully. Please see below code:

Object: Once the character limit has been reached, paste remainder text in the cells below one another.
Eg: I have copied text that has 80,000 characters in it: Cell A1 - paste 32,767 characters -> then
spill over remainder characters to Cell A2 - paste 32,767 characters -> then
spill over remainder characters to Cell A2 - paste 14,466 characters -> Finished

' Fetch Entire Source Code

Private Sub HTML_VBA_Excel()

Dim oXMLHTTP As Object
Dim sPageHTML As String
Dim sURL As String

'Change the URL before executing the code
sURL = Google

'Extract data from website to Excel using VBA
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.send
sPageHTML = oXMLHTTP.responseText

' Get webpage data into Excel
' If longer source code mean, you need to save to a external text file or somewhere,
' since excel cell have some limits on storing max characters
' I would like to split the HTML code before it gets pasted to the excel file, to work around the character limits within an excel “Cell”.
ThisWorkbook.Sheets(1).Cells(1, 1) = sPageHTML

MsgBox "XMLHTML Fetch Completed"

End Sub

 

[Micron]

untested, but maybe

Dim sPageHTML As String
Dim i As Integer

i = 1
Do Until Len(sPageHTML) < 32767
   Range("A" & i) = Left(sPageHTML, 32767)
   sPageHTML = Replace(sPageHTML, Left(sPageHTML, 32767), "")
   Debug.Print sPageHTML
   i = i + 1
Loop

 

[MelodyCosta]

untested, but maybe

Dim sPageHTML As String
Dim i As Integer

i = 1
Do Until Len(sPageHTML) < 32767
   Range("A" & i) = Left(sPageHTML, 32767)
   sPageHTML = Replace(sPageHTML, Left(sPageHTML, 32767), "")
   Debug.Print sPageHTML
   i = i + 1
Loop

Hi there:

Thank you for all your help. I tested the code last night and it works good but of course the first website that I choose just happens to be longer then the span (or limit) of the 3 cells that the text spills over into. Is there a way to have the code spill into as many cells as needed, automatically or dynamically?

Eg: the below website is the same for each but each page code fills a different amount of cells (this example is completely fake):

www.google.com, fills cells A1 to B1

www.google.com/holdinghands/, fills cells A1​

www.google.com/holdinghands/tootight/, fills cells A1, B1 and C1

www.google.com/holdinghands/forever/, fills cells A1, B1, C1 and would have continued to fill the cells D1-G1 but the code limits it to cells A, B and C leaving it as an incomplete code extraction.​

I hope this all makes sense. Please reach out to me if you need me to clarify my thoughts here.

Greatly appreciative of all your help, Melody Costa

 

[Micron]

I think you're saying that because of the cell max character count, you're ending up with the long string spread over A, B and C?
Then I would just put the string into a variable and not a sheet because the max character count would be more than 2 billion IIRC. I have to run out for a while, but if you want to take a stab at it, change function to
Sub testLongString(strIn As String)
and replace ThisWorkbook.Sheets(1).Cells(1, 1) = sPageHTML with
testLongString(sPageHTML)

Tried to use your code to test that but I get "system error" -2147012890 at
oXMLHTTP.Open "GET", sURL, False

I have a reference set to html object library, so I guess that's not the issue. Totally unfamiliar with what you're doing there.
BTW, when I said that code was untested I meant to that extent. I played around with just a few characters so the debug line was ok for me. You might want to remove it.

 

[MelodyCosta]

I think you're saying that because of the cell max character count, you're ending up with the long string spread over A, B and C?
Then I would just put the string into a variable and not a sheet because the max character count would be more than 2 billion IIRC. I have to run out for a while, but if you want to take a stab at it, change function to
Sub testLongString(strIn As String)
and replace ThisWorkbook.Sheets(1).Cells(1, 1) = sPageHTML with
testLongString(sPageHTML)

Tried to use your code to test that but I get "system error" -2147012890 at
oXMLHTTP.Open "GET", sURL, False

I have a reference set to html object library, so I guess that's not the issue. Totally unfamiliar with what you're doing there.
BTW, when I said that code was untested I meant to that extent. I played around with just a few characters so the debug line was ok for me. You might want to remove it.

Yes, the code if copied and pasted all at one will give you an error message but if you copy and past it in sections it works.

Mind you I am working from my clean copy and then commenting out ' ThisWorkbook.Sheets(1).Cells(1, 1) = sPageHTML and then placing your text directly below this line and removing Dim sPageHTML As String as I have already declared this in the beginning and it will work.

I think somehow when I copied the code and pasted it, it must have collected some formatting and that is where all the errors are coming from.

In the meantime, I have figured out a workaround where I have it pasted into a word doc and then from there I will tweak excel VBA to extract certain text from that word doc.

Thank you once again. Mel

 

[Micron]

What errors? Did you remember to alter the function as well? Should look like

Function testLongString(strIn As String) As String
Dim i As Integer

i = 1
Do Until Len(strIn) < 32767
   Range("A" & i) = Left(strIn, 32767)
   sPageHTML = Replace(strIn, Left(strIn, 32767), "")
   'Debug.Print strIn
   i = i + 1
Loop
End Function

Private Sub HTML_VBA_Excel()
Dim oXMLHTTP As Object
Dim sPageHTML As String, sURL As String, strOut As String

'Change the URL before executing the code
sURL = "www.google.com/holdinghands/forever/"

'Extract data from website to Excel using VBA
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.Send
sPageHTML = oXMLHTTP.responseText
testLongString sPageHTML
'''ThisWorkbook.Sheets(1).Cells(1, 1) = sPageHTML
MsgBox "XMLHTML Fetch Completed"
'''
Set oXMLHTTP = Nothing

End Sub

 

[Micron]

It never ends. Missed replacing function variable as in

strIn = Replace(strIn, Left(strIn, 32767), "")

 

[MelodyCosta]

I am obviously doing something wrong then. Because I can't get your code to work from my end but I did get it to work from this code, and I arrived at this code from the way I described it above.

Private Sub HTML_VBA_Excel()
     Dim oXMLHTTP As Object
     Dim sPageHTML As String
     Dim sURL As String
    
     'Change the URL before executing the code
      sURL = https://plrplr.com/category/blogging-2/
    
     'Extract data from website to Excel using VBA
    
     Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
     oXMLHTTP.Open "GET", sURL, False
     oXMLHTTP.send
     sPageHTML = oXMLHTTP.responseText
    
     'Get webpage data into Excel
    
     ' If longer sourcecode mean, you need to save to a external text file or somewhere,
     ' since excel cell have some limits on storing max Characters
    
     ' Decided to dynamicaly extract data into as many cells per colunm as needed [fix excel max cell Char}
     ' ThisWorkbook.Sheets(1).Cells(1, 1) = sPageHTML
    
Dim i As Integer

i = 1

Do Until Len(sPageHTML) < 32767
   Range("A" & i) = Left(sPageHTML, 32767)
   sPageHTML = Replace(sPageHTML, Left(sPageHTML, 32767), "")
   Debug.Print sPageHTML
  
   i = i + 1
  
Loop
            
    MsgBox "XMLHTML Fetch Completed"

    End Sub

 

[Micron]

OK. So I take it that you got the code to work simply by inserting the part that was in the function into your code, which is one option I mentioned. If that means you no longer need to use Word, then perhaps mark this issue as solved?