String text in Word html. Passing info between Word and Excel

Some notes and tests in support of possible answer to this Thread:

http://www.excelfox.com/forum/showth...rom-Excel-Data
Related also to these posts:
https://tinyurl.com/y3j3klvo
https://tinyurl.com/y5n4x7ku
https://tinyurl.com/y4av8rer
https://tinyurl.com/y4b34a9g

---

Code to make Day list from Excel File and show in Pop up Word .htm File.
MakeTagList Button , Sub MakeTagList()

This post gives some Overview notes for later reference to help clarify some other more detailed excelfox Threads.

MakeTagList Button. Briefly, overview:
The code Sub MakeTagList(), primarily does two things:
_ makes a simple text file with the important details from a Daily Diet Protocol
DailyTextFileForEmailAttatchment.JPG : https://imgur.com/MqEmlDF
Attachment 2053

_ makes a long string of HTML coding which if written to a text file, (but with the usually given .txt extension replaced with .htm ), is recognised by Microsoft Word which can open it in a form which looks similar to a normal Word doc
That Word File is opened temporarily to show a pretty table form of the important details from a Daily Diet Protocol:
TemporaryWordPopUp.JPG : https://imgur.com/ZFhsdaQ
Attachment 2054

_.___________



_ makes a simple text file with the important details from a Daily Diet Protocol
arrNuts()
The start point is that an array is made of used food products from daily pro, arrNuts()
arrNuts() is the = Items() array from a Dictionary. So it is a one dimension array starting at arrNuts(0). Each Element is a row from the from the Daily Excel Diet Protocol File, "ProAktuellex8600x2.xlsm". It is built up from a line like pseudo

Code:

---

        Key:=ProRow with Entry in C column, Item:=Array(FoodProduct in 1st Column A , amount eaten from 3rd Column C  , Kcal total in 9th column I  , Fett , Eiweiß  …. Etc.

---

( The Key is not used currently )

Rem 5 Text File
A text file is made from the array with a pipe, _ | _ , as separator like from:
arrNuts(0)(0) & "|" & arrNuts(0)(1) & "|" & arrNuts(0)(2) ……..etc..
arrNuts(1)(0) & "|" & arrNuts(1)(1) & "|" & arrNuts(1)(2) ……..etc..
arrNuts(2)(0) & …..etc..
The final text file is stored in the same Folder as most of the files to do with daily protocols, that is to say, the currently used main Folder . It is given a name something of the form pseudo
"MonatsUebersichtAnhang " & Date in format like "mmmm yyyy" & ".txt"
As example for any day in April, 2018, it will be like
"MonatsUebersichtAnhang April 2018.txt"
The main purpose of this text file is to have a file that can be attached to an Email which at the receiving end can then be for recording and using the important daily nutrition values in a graphic
I use the standard VBA type code lines for this , pseudo like
Open C: \ __ \ _ \ ¬¬¬-___"MonatsUebersichtAnhang April 2018.txt" For __ As __
_.___________

_ makes a long string of HTML coding which if written to a text file, (but with the usually given .txt extension replaced with .htm ), is recognised by Microsoft Word and can opens it in a form which looks similar to a normal Word doc
Rem 6 .htm Word Template File
An empty or almost empty .htm Word file, "DailyProtable.htm " , ( which should be in the main currently used Folder already , - ( download from box if necessary ) ) is converted into a single very long String variable , TotalFile
I use the fairly standard VBA way often used to get this long string from a .txt file. It seems to work equally well for a .htm file

Code:

---

Rem 6 get Template File as long HTML string . Template file is an almost empty Word .htm file.
Dim FileNum As Long: Let FileNum = FreeFile(1)    ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
 Let PathAndFileName = ThisWorkbook.Path & "\" & "DailyProtable.htm" ' Template file never changes
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    TotalFile = Space(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , TotalFile
  Close #FileNum
Rem 7 modify main body text section of the template file

---

Rem 7
Things start getting a bit complicated now. It may help at this point to give a summary of the overall goal:
The final aim of this code and the associated code usually done just after, Sub PetrasDailyProWay1_COM_Way() , is to get a pretty summary table in a HTML code such as it is in a form that can be used for two things:
_ Temporarily in a Word .htm file which is opened temporarily to show the current stand of a finished or almost finished protocol,
_ part of that ( the main body part ) can be isolated into a functioning variable , MyLengthyStreaming , and used in the typical LECMO technology code lines of the form
CDO.Message.HTMLBody = MyLengthyStreaming
CDO.Message.Send
( In actual fact the entire Word.htm HTML string, TotalFile , could usually be used, but I do not do this as
_ TotalFile has a lot of unnecessary text, presumably needed for Word .htm file recognition
as well as
_ there are some subtle problems which need to be addresses with the string before it can be used with German Telekom, as it appears that a Bug means that the German Telekom does not quite recognise correctly that standard HTML coding ( gmail and AOL seem not to have this problem ) https://telekomhilft.telekom.de/t5/E...136416#M129791 )

What basically needs to be done is to modify the TotalFile at the main body part. This Part of the text is almost empty at this stage. That almost empty main body part is replaced by a made pretty HTML table
It is all done in a bit of a messy way, and it is easy to lose track of what is going on. Once again, the purpose of this code:
The code Sub MakeTagList(), primarily
_ makes a simple text file with the important details from a Daily Diet Protocol
_ makes a long string of HTML coding which if written to a text file, (but with the usually given .txt extension replaced with .htm ), is recognised by Microsoft Word and can opens it in a form which looks similar to a normal Word doc


_ makes a long string of HTML coding which if written to a text file, (but with the usually given .txt extension replaced with .htm ), is recognised by Microsoft Word and can opens it in a form which looks similar to a normal Word doc
In Rem 7 we basically embed a Table ( in HTML coding form ) by doing a simple Replace of the start part of the main body in the string from the Template .htm file which looks like this
<div class=WordSection1> ( You can see that yourself if you open up the .htm file using a simple text editor, and look towards the end MainWordSectionBody.JPG : https://imgur.com/HWjHTyz )
That existing HTML coding, <div class=WordSection1> , is Replaced by
<div class=WordSection1> & A made HTML table done in a Function
That Function is called using the arrNuts() thus:
ProTble(arrNuts())

Function ProTble()
By a bit of trial and error and learning some basic HTML coding I was able to write this function which based on the data given in arrNuts() gives a lot of HTML coding which a Browser ( or Word when it has it included in the long HTML string opened using a .htm extension file ) can understand and produce a table formatted as I want:

Rem 8
Back in the main code we now have our original full file text string of HTML coding, TotalFile , modified to include in it the pretty table
The string is printed out to a text file in the usually way but with the .htm extension instead of the usual .txt extension. This file is currently given the name
"DailyProtableFilled.htm"

Code:

---

Rem 8 Over write the last ( likely yesterdays ) filled file,  with the modified template file which is mainly still that what Word recognises as we only modified a bit of the main text body
Dim HighwayToHelloPro As Long ' For rewrite of modified DailyProtable.htm as DailyProtable.htm2
 Let HighwayToHelloPro = FreeFile(0)
 Open ThisWorkbook.Path & "\" & "DailyProtableFilled.htm" For Output As #HighwayToHelloPro ' Will be made if not there, and overwritten as Output rahter than Append
 Print #HighwayToHelloPro, TotalFile
 Close #HighwayToHelloPro
Rem 9 get Word using Excel

---

Rem 9
The final part of the code, Sub MakeTagList() , which is initiated by the Button, MakeTagList , brings up the file, "DailyProtableFilled.htm" , temporarily in Microsoft Word.

_.___________

Required Files:
Daily Diet Protocol :
"ProAktuellex8600x2.xlsm" :
https://app.box.com/s/fpztob9pcp92fl6hh81zgpzumw9ntcp0 ( Current )
https://www.magentacloud.de/share/38m-zuc2y3#$/ ( April 2018 )

Main Makro File:
"NeuProAktuelleMakros.xlsm" :
https://app.box.com/s/e93u19xidygreeeenlxyupm750dxe33f ( Current )
https://www.magentacloud.de/share/38m-zuc2y3#$/ ( April 2018 )

Usually in practical use, the execution of the last coding would be followed by the sending of the EMail using the Send Pro Mail Button.








Ref:
http://www.eileenslounge.com/viewtop...=29556#p228710
http://www.excelfox.com/forum/showth...0528#post10528

Coding in support of this Thread
http://www.excelfox.com/forum/showth...1384#post11384

Code:

---

Option Explicit
'Sub LateEarlyBinding()
' On Error Resume Next ' If it is always there you get  Name steht in Konflikt mit vorhandenem Modul, Projekt oder vorhandener Objektbibliothek  RuntimeError32813.JPG : https://imgur.com/N0BN7m2    If it is not there then usually it does not error, but will in Debug F8 mode  Change to the hold mode is not possible at this time.JPG : https://imgur.com/v9inlwM but it works anyway and ignores the error handler in this case
' ThisWorkbook.VBProject.References.AddFromguid GUID:="{420B2830-E718-11CF-893D-00A0C9054228}", major:=1, Minor:=0
' Debug.Print Err.Description
' On Error GoTo 0 ' Clears exception and the  Err.Description  also is cleared
'End Sub
Sub MakeTagList() ' A Table  is made and embedded in the main body text of an existing .htm Word readable file which must already exist and be in the same folder as this workbook. That is set to pop up in word briefly. (The main body of the htm file can  then used later as the .HTMLBody in an email )
'                                            Call LateEarlyBinding ' Microsoft Scripting Runtime
Rem 4 Array from range
Dim arrNuts() As Variant: Let arrNuts() = ThisWorkbook.Worksheets.Item(1).Range("A2:B3").Value
Rem 6 get Template File as long HTML string . Template file is an almost empty Word .htm file with just    "I would like to put here Table1. Here is some other text"  .
Dim FileNum As Long: Let FileNum = FreeFile(1)    ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
 Let PathAndFileName = ThisWorkbook.Path & "\" & "WordFile.htm" ' Template file never changes
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    TotalFile = Space(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , TotalFile
  Close #FileNum
 Debug.Print TotalFile
Rem 7 modify main body text section of the template file
'7a) Start bit, and call of HTML table genarator Function
Dim MyLengthyStreaming As String
 Let MyLengthyStreaming = "<p></p><p></p>" & MyLengthyStreaming & ProTble(arrNuts())
 Let TotalFile = Replace(TotalFile, "Table:_1.<o:p></o:p></span></i></p>", "Table:_1.<o:p></o:p></span></i></p>" & vbCrLf & MyLengthyStreaming, 1, 1, vbTextCompare)
'7b) anything after table
Dim sT As String, aFt As String: Let sT = "Bit after table to aid in adding stuff in main code" ' This string was put on the end od the final HTML table so as to have a thing to replace with something like the end of th table
 Let aFt = "<p>" & ThisWorkbook.Worksheets.Item(1).Range("A1").Value & "</p><p>.</p>" ' Put table Header under table
' Let aFt = "<p><span style=""color: #ff00ff;"">'_---Table made " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ====Daily Foods Table End ======</span></p>"
 Let TotalFile = Replace(TotalFile, sT, aFt, 1, 1, vbBinaryCompare)
' Debug.Print TotalFile
Rem 8 Make new file with modified long HTML string
Dim HighwayToHelloPro As Long ' For rewrite of modified DailyProtable.htm as DailyProtable.htm2
 Let HighwayToHelloPro = FreeFile(0)
 Open ThisWorkbook.Path & "\" & "WordFile2.htm" For Output As #HighwayToHelloPro ' Will be made if not there, and overwritten as Output rahter than Append
 Print #HighwayToHelloPro, TotalFile
 Close #HighwayToHelloPro
Rem 9 get Word using Excel
Dim appWord As Object                          '  Dim appWord As Word.Application
 Set appWord = CreateObject("Word.Application") '  Set appWord = New Word.Application '
 appWord.Visible = True
 appWord.Documents.Open Filename:=ThisWorkbook.Path & "\" & "WordFile2.htm", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=0, XMLTransform:="", DocumentDirection:=0
 appWord.Documents("WordFile2.htm").Activate
 Application.WindowState = xlMinimized
 Application.OnTime Now + TimeSerial(0, 0, 5), "Modul1.GetWordObjClose"
'9b) Some Word Formatting
'Windows("ProAktuellex8600x211.3.xlsm").Activate
'Dim docMsg As Document '
' Set docMsg = ActiveDocument ' Documents("DailyProtableFilled")
' docMsg.Range(0, 100).Select
'  Selection.WholeStory
'    With Selection.ParagraphFormat
'    .SpaceBeforeAuto = False
'    .SpaceAfterAuto = False
'    End With
End Sub
Sub GetWordObjClose() ' Close the daily pro in word
 Application.WindowState = xlNormal
Dim appWord As Object ' Dim appWord As Word.Application
 Set appWord = GetObject(, "Word.Application"): appWord.Visible = True ' This will open new instance of word and make it visible ( with no document). If one is open then it will be set to the appWord variable
Dim Dock As Variant
    For Each Dock In appWord.Documents
    Dock.Save
    Dock.Close
    Next Dock
' appWord.ActiveDocument.Save
' appWord.ActiveDocument.Close
 appWord.Quit
 Application.WindowState = xlNormal
 'Application.Windows("" & ProWb.Name & "").Activate
 'Application.Windows("" & ProWb.Name & "").WindowState = xlNormal
 'ActiveWindow.WindowState = xlNormal
End Sub
Function ProTble(ByRef arrNuts() As Variant) As String
' Table start
Let ProTble = _
"<table width=800" & vbCrLf & _
"<col width=400" & vbCrLf & _
"<col width=400>" & vbCrLf & vbCrLf
Dim iCnt As Long, jCnt As Long ' data "rows" , "columns"
    For jCnt = 1 To UBound(arrNuts(), 1)
    Dim LisRoe As String
    Let LisRoe = LisRoe & "<tr height=16>" & vbCrLf
        For iCnt = 1 To UBound(arrNuts(), 2)
        Let LisRoe = LisRoe & "<td>" & arrNuts(jCnt, iCnt) & "</td>" & vbCrLf
        Next iCnt
    Let LisRoe = LisRoe & "</tr>" & vbCrLf & vbCrLf
    Let ProTble = ProTble & LisRoe
    Let LisRoe = ""
    Next jCnt
Let ProTble = ProTble & "</table>" ' table end
' Bit after table to aid in adding stuff in main code
 Let ProTble = ProTble & "Bit after table to aid in adding stuff in main code"
End Function

---

---

"WordFile.htm" : https://app.box.com/s/xl1l7noo2nf7znnzyz6evqaeiuu37gcz

Get the Color shade you want to come out in Final Post

I expect there is a better way to do this, but I just hit on a way that works quite well, so I will document and share that now , and edit and update later if I come up with a more scientific and/ or automated way.

As an example , say I have seen this: _ shade _ somewhere, as you see it here, ( there ) . Lets assume I want to post that word in a Forum editor which accepts BB Code tags, ( BB Code tags: http://www.excelfox.com/forum/misc.php?do=bbcode ) such that I get that _ shade _ in the final post just as you see it here ( there )

Here is a way to do it:
_1 ) Use Word to get the shade of shade that you want,
:rolleyes: :for example,
_ 1A) highlight any text and experiment with its color:
Word Text Color 0.JPG : https://imgur.com/xpCoo8B
Word Text Color 1 2.JPG : https://imgur.com/agdUo2f
Word Text Color 3.JPG : https://imgur.com/H5czlGV
Word Text Color 4.JPG : https://imgur.com/2ff71Xq
( Hit OK when finished to change selection color)
Attachment 1981Attachment 1982Attachment 1983Attachment 1984

_ 1B) As an alternative start point, you can find any text color anywhere, for example in the internet, paste into Word and adjust it in Word as per _ 1A)

_2 ) Copy the final Text to the clipboard.
Search the internet for any Word to HTML converter, there are many free ones available. Typically you can paste anything into a Visual Editor and then choose to obtain the HTML code
WordVisualToHTML.JPG : https://imgur.com/T19SMxG
Attachment 1980

_3 ) In the given HTML code will typically be some part referring to the text shade,_..

HTML Code:

---

<p><span style="font-size: 11pt; line-height: 115%; font-family: Verdana, sans-serif; color: #417394;">shade</span></p>

---

_.. here for example, the number of interest is _ color: #417394

_4 ) I assume the number used in the square bracket [ BB Code Color Tags ] pair is the same as in pointy bracket < HTML > code Tags color bit. It appears to be.
So for our example shade you would use this in a forum post_..
____ [color=#417394] shade [/color]
_.. which would come out like this:
__________________ shade

( If you want to keep the indent, as I did here (there), and avoid the forum editor “eating” spaces of more than one, ( as most forum editors do this ) ) , then use the white character trick: Post something like this:
[color=white]_ Any_White_Profanity Text [/color] [color=#417394] shade [/color]




Alan

DocAElstein
[color=#417394]
[B][u]DocAElstein[/u][/B][/color]
https://imgur.com/MKMjW0b



Ref
http://www.excelfox.com/forum/showth...plete-Document
https://imgur.com/MKMjW0b
http://www.excelfox.com/forum/misc.php?do=bbcode
https://wordtohtml.net/
http://services.runescape.com/m=foru...9,877,64690220
http://www.excelfox.com/forum/showth...age2#post10131

spare post for later use

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://eileenslounge.com/viewtopic.php?p=316441#p316441
https://eileenslounge.com/viewtopic.php?p=324736#p324736
https://eileenslounge.com/viewtopic.php?p=324990#p324990
https://eileenslounge.com/viewtopic.php?f=27&t=41937&p=325485#p325485
https://eileenslounge.com/viewtopic.php?p=325609#p325609
https://eileenslounge.com/viewtopic.php?p=325610#p325610
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGADdPM65i9PG
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGADdPQHFk_zm
http://www.eileenslounge.com/viewtopic.php?p=324457#p324457
http://www.eileenslounge.com/viewtopic.php?p=324064#p324064
http://www.eileenslounge.com/viewtopic.php?p=323960#p323960
https://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgyZCnNfnZRfgwzDlQF4AaABAg
https://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgyZCnNfnZRfgwzDlQF4AaABAg. ADd4m2zp_xDADd6Nnotj1C
s://www.youtube.com/watch?v=7VwD9KuyMk4&lc=UgySdtXqcaA27wQLd1t4AaABAg
http://www.eileenslounge.com/viewtopic.php?p=323959#p323959
http://www.eileenslounge.com/viewtopic.php?f=30&t=41784
http://www.eileenslounge.com/viewtopic.php?p=323966#p323966
http://www.eileenslounge.com/viewtopic.php?p=323959#p323959
http://www.eileenslounge.com/viewtopic.php?p=323960#p323960
http://www.eileenslounge.com/viewtopic.php?p=323894#p323894
http://www.eileenslounge.com/viewtopic.php?p=323843#p323843
https://www.youtube.com/watch?v=fEHKPhJxgBA&lc=Ugxx8_MjhC9FDaQgcHN4AaABAg
https://www.youtube.com/watch?v=jpjYm4UvyWk&lc=Ugx_Qd4rfAN_ZYcJbo94AaABAg. ACGbG9c76OWACGbjKa7H8k
https://www.youtube.com/watch?v=jpjYm4UvyWk&lc=Ugx_Qd4rfAN_ZYcJbo94AaABAg
https://www.youtube.com/watch?v=GyPHaydeng0&lc=UgzE4a4f_e_y9Rk5OR94AaABAg
https://www.youtube.com/watch?v=I5FkNG94BcQ&lc=UgxXnkEHqulXSR5tXwh4AaABAg
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa6BSa173Z
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa6-64Xpgl
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa5ms39yjd
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa5ZXJwRCM
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa4Pr15NUt
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa4I83JelY
https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGADdMo2n-hyF
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

Some notes in support of this Thread: https://excelfox.com/forum/showthrea...ll=1#post15623


Compare an empty Word document with a Word document with some arbitrary text, when both are saved in the .htm format.

To help with later programming, I will run the macro recorder while making the two files.
So this is a walk through it…
_ Start the macro recorder
_ make a new file
_ save it as docHTML1.htm
_ close it

_ make a new file
_ add the text some arbitrary text
¬_ save it as docHTML2.htm
_ close it

This is the basic macro produced by recorder. ( I changed/ rearranged a few things and added a few 'comments, but it is the same basic coding

Code:

---

Sub Makro5()
 Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0 ' _ make a new file
 ActiveDocument.SaveAs Filename:="docHTML1.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False  '  _ save it as docHTML1.htm
 ActiveWindow.View.Type = wdWebView
 ActiveDocument.Close ' _ close it

 Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0 ' _ make a new file
 Selection.TypeText Text:="some arbritrary text"    '  _ add the text some arbitrary text
 ActiveDocument.SaveAs Filename:="docHTML2.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False  '  _ save it as docHTML2.htm
 ActiveWindow.View.Type = wdWebView
 ActiveDocument.Close '  _ close it
End Sub

---

This is what I see appear as a result of doing the above:
Two htm files and other stuff appeared.JPG
https://i.postimg.cc/0rF47qYk/Two-ht...f-appeared.jpg
https://i.postimg.cc/pmmzzpHr/Two-ht...f-appeared.jpg

If I now open those two htm files with a text editor, I see this ( I am only showing the last bits below as there is more than the post limit allows )
docHTML1.htm: https://app.box.com/s/l16u4vxavd8kjd1lzo3arb97rw4yoww1

Code:

---

        mso-hansi-font-family:Calibri;
        mso-hansi-theme-font:minor-latin;
        mso-fareast-language:EN-US;}
</style>
<![endif]--><!--[if gte mso 9]><xml>
 <o:shapedefaults v:ext="edit" spidmax="2050"/>
</xml><![endif]--><!--[if gte mso 9]><xml>
 <o:shapelayout v:ext="edit">
  <o:idmap v:ext="edit" data="1"/>
 </o:shapelayout></xml><![endif]-->
</head>

<body lang=DE style='tab-interval:35.4pt'>

<div class=WordSection1>

<p class=MsoNormal><o:p>&nbsp;</o:p></p>

</div>

</body>

---

docHTML2.htm: https://app.box.com/s/quzanrhoopgdyzvk9dc5cbj9y0quuk4x

Code:

---

        font-family:"Calibri","sans-serif";
        mso-ascii-font-family:Calibri;
        mso-ascii-theme-font:minor-latin;
        mso-hansi-font-family:Calibri;
        mso-hansi-theme-font:minor-latin;
        mso-fareast-language:EN-US;}
</style>
<![endif]--><!--[if gte mso 9]><xml>
 <o:shapedefaults v:ext="edit" spidmax="2050"/>
</xml><![endif]--><!--[if gte mso 9]><xml>
 <o:shapelayout v:ext="edit">
  <o:idmap v:ext="edit" data="1"/>
 </o:shapelayout></xml><![endif]-->
</head>

<body lang=DE style='tab-interval:35.4pt'>

<div class=WordSection1>

<p class=MsoNormal><span class=SpellE>some</span> <span class=SpellE>arbritrary</span>
text</p>

</div>

</body>

</html>

---

What is going on there is that the lot of complicated html stuff ( of which I only show a bit ) is how a simple Microsoft Word document looks like if written in html. So for example, if you wanted to view your word document using an internet browser, then you would give the browser something like that. You can actually try that:
View htm file in browser.JPG
https://i.postimg.cc/c6VS0zLz/View-h...in-browser.jpg

---

---

Here for comparison is a file I used to give some summary in a Word doco. This is the file without yet any info in it, ( as a text file )
DailyProtable.txt : https://app.box.com/s/q0tyxq8qptdb50oxxxtplbf9ur3xaeu2

Code:

---

</style>
<![endif]--><!--[if gte mso 9]><xml>
 <o:shapedefaults v:ext="edit" spidmax="4098"/>
</xml><![endif]--><!--[if gte mso 9]><xml>
 <o:shapelayout v:ext="edit">
  <o:idmap v:ext="edit" data="1"/>
 </o:shapelayout></xml><![endif]-->
</head>

<body lang=DE style='tab-interval:35.4pt'>

<div class=WordSection1>

<p class=MsoNormal><o:p>&nbsp;</o:p></p>

<p class=MsoNormal><o:p>&nbsp;</o:p></p>

<p class=MsoNormal><b><span style='color:#D99594;mso-themecolor:accent2;
mso-themetint:153'>X <span class=SpellE>x</span> <span class=SpellE>x</span> <span
class=SpellE>x</span> <span class=SpellE>x</span> <o:p></o:p></span></b></p>

</div>

</body>

</html>

---

This is the same file again with the information filled in it:
DailyProtableFilled.txt : https://app.box.com/s/l16u4vxavd8kjd1lzo3arb97rw4yoww1

Code:

---

<style>
<!--
 /* Font Definitions */
 @font-face
        {font-family:"Cambria Math";
        panose-1:2 4 5 3 5 4 6 3 2 4;
        mso-font-charset:1;
        mso-generic-font-family:roman;
        mso-font-format:other;
        mso-font-pitch:variable;
        mso-font-signature:0 0 0 0 0 0;}
@font-face
        {font-family:Calibri;
        panose-1:2 15 5 2 2 2 4 3 2 4;
        mso-font-charset:0;
        mso-generic-font-family:swiss;
        mso-font-pitch:variable;
        mso-font-signature:-1610611985 1073750139 0 0 159 0;}
 /* Style Definitions */
 p.MsoNormal, li.MsoNormal, div.MsoNormal
        {mso-style-unhide:no;
        mso-style-qformat:yes;
        mso-style-parent:"";
        margin-top:0cm;
        margin-right:0cm;
        margin-bottom:10.0pt;
        margin-left:0cm;
        line-height:115%;
        mso-pagination:widow-orphan;
        font-size:11.0pt;
        font-family:"Calibri","sans-serif";
        mso-ascii-font-family:Calibri;
        mso-ascii-theme-font:minor-latin;
        mso-fareast-font-family:Calibri;
        mso-fareast-theme-font:minor-latin;
        mso-hansi-font-family:Calibri;
        mso-hansi-theme-font:minor-latin;
        mso-bidi-font-family:Arial;
        mso-bidi-theme-font:minor-bidi;
        mso-fareast-language:EN-US;}
span.SpellE
        {mso-style-name:"";
        mso-spl-e:yes;}
.MsoChpDefault
        {mso-style-type:export-only;
        mso-default-props:yes;
        font-size:10.0pt;
        mso-ansi-font-size:10.0pt;
        mso-bidi-font-size:10.0pt;
        mso-ascii-font-family:Calibri;
        mso-ascii-theme-font:minor-latin;
        mso-fareast-font-family:Calibri;
        mso-fareast-theme-font:minor-latin;
        mso-hansi-font-family:Calibri;
        mso-hansi-theme-font:minor-latin;
        mso-bidi-font-family:Arial;
        mso-bidi-theme-font:minor-bidi;
        mso-fareast-language:EN-US;}
@page WordSection1
        {size:595.3pt 841.9pt;
        margin:70.85pt 70.85pt 2.0cm 70.85pt;
        mso-header-margin:35.4pt;
        mso-footer-margin:35.4pt;
        mso-paper-source:0;}
div.WordSection1
        {page:WordSection1;}
-->
</style>
<!--[if gte mso 10]>
<style>
 /* Style Definitions */
 table.MsoNormalTable
        {mso-style-name:"Normale Tabelle";
        mso-tstyle-rowband-size:0;
        mso-tstyle-colband-size:0;
        mso-style-noshow:yes;
        mso-style-priority:99;
        mso-style-qformat:yes;
        mso-style-parent:"";
        mso-padding-alt:0cm 5.4pt 0cm 5.4pt;
        mso-para-margin:0cm;
        mso-para-margin-bottom:.0001pt;
        mso-pagination:widow-orphan;
        font-size:10.0pt;
        font-family:"Calibri","sans-serif";
        mso-ascii-font-family:Calibri;
        mso-ascii-theme-font:minor-latin;
        mso-hansi-font-family:Calibri;
        mso-hansi-theme-font:minor-latin;
        mso-fareast-language:EN-US;}
</style>
<![endif]--><!--[if gte mso 9]><xml>
 <o:shapedefaults v:ext="edit" spidmax="4098"/>
</xml><![endif]--><!--[if gte mso 9]><xml>
 <o:shapelayout v:ext="edit">
  <o:idmap v:ext="edit" data="1"/>
 </o:shapelayout></xml><![endif]-->
</head>

<body lang=DE style='tab-interval:35.4pt'>

<div class=WordSection1>
<p><span style="color: #ff00ff;">'_-Start=========== 02 April 2018 02.04.2018 21:55:52 ------------------------------------</span></p><table width=800
<col width=200
<col width=50>
<col width=50>
<col width=50>
<col width=50>
<col width=50>
<col width=50>
<col width=50>
<col width=50>
<col width=50>
<col width=50>
<tr height=17>
<td>Food Product</td>
<td>g</td>
<td>Kcal</td>
<td style="color:red;background:#F2DDDC">Fett</td>
<td style="color:blue;background:#DBE5F1">Protein</td>
<td style="background:#D8D8D8">Koh</td>
<td style="color:silver;background:#D8D8D8">Zucker</td>
<td style="color:brown;background:#DDD9C3">Ballastoffe</td>
<td style="color:green;background:#EAF1DD">Wasser</td>
<td style="color:purple;background:#E5E0EC">kalium</td>
<td style="background:#DBEEF3">Natrium+</td>
</tr><tr height=17>
<td>NescafeEntkoffinieret</td>
<td>14g</td>
<td>16.52</td>
<td style="color:red;background:#F2DDDC">0.028</td>
<td style="color:blue;background:#DBE5F1">1.092</td>
<td style="background:#D8D8D8">0.434</td>
<td style="color:silver;background:#D8D8D8">0.434</td>
<td style="color:brown;background:#DDD9C3">4.774</td>
<td style="color:green;background:#EAF1DD"></td>
<td style="color:purple;background:#E5E0EC"></td>
<td style="background:#DBEEF3">0.014</td>
</tr>
<tr height=17>
<td>G&GSuessstoffTabletten</td>
<td>0.2g</td>
<td>0.04</td>
<td style="color:red;background:#F2DDDC"></td>
<td style="color:blue;background:#DBE5F1"></td>
<td style="background:#D8D8D8">0</td>
<td style="color:silver;background:#D8D8D8">0</td>
<td style="color:brown;background:#DDD9C3">0</td>
<td style="color:green;background:#EAF1DD"></td>
<td style="color:purple;background:#E5E0EC"></td>
<td style="background:#DBEEF3">0.0274</td>
</tr>
<tr height=17>
<td>SuessliStevia(Flussig)</td>
<td>0.2g</td>
<td>0.001</td>
<td style="color:red;background:#F2DDDC"></td>
<td style="color:blue;background:#DBE5F1"></td>
<td style="background:#D8D8D8"></td>
<td style="color:silver;background:#D8D8D8"></td>
<td style="color:brown;background:#DDD9C3"></td>
<td style="color:green;background:#EAF1DD"></td>
<td style="color:purple;background:#E5E0EC"></td>
<td style="background:#DBEEF3"></td>
</tr>
<tr height=17 style="color:darkblue;background:pink">
<td>Pro For Montag 02 April 02 04 2018</td>
<td>14.4g</td>
<td style="color:orange;background:white;height:21">17Kcal</td>
<td style="color:red;background:white">0.028</td>
<td style="color:blue;background:white">1.092</td>
<td style="background:white">0.434</td>
<td style="color:silver;background:white">0.434</td>
<td style="color:brown;background:white">4.774</td>
<td style="color:green;background:white"></td>
<td style="color:purple;background:white"></td>
<td style="background:white">0.041</td>
</tr>
<tr height=17 style="color:darkblue;background:pink">
<td>Main Foods</td>
<td>14.4g</td>
<td>16.561</td>
<td style="color:red;background:#F2DDDC">0.028</td>
<td style="color:blue;background:#DBE5F1">1.092</td>
<td style="background:#D8D8D8">0.434</td>
<td style="color:silver;background:#D8D8D8">0.434</td>
<td style="color:brown;background:#DDD9C3">4.774</td>
<td style="color:green;background:#EAF1DD"></td>
<td style="color:purple;background:#E5E0EC"></td>
<td style="background:#DBEEF3">0.0414</td>
</tr>
<tr height=17>
<td>Fruit</td>
<td>0g</td>
<td></td>
<td style="color:red;background:#F2DDDC"></td>
<td style="color:blue;background:#DBE5F1"></td>
<td style="background:#D8D8D8"></td>
<td style="color:silver;background:#D8D8D8"></td>
<td style="color:brown;background:#DDD9C3"></td>
<td style="color:green;background:#EAF1DD"></td>
<td style="color:purple;background:#E5E0EC"></td>
<td style="background:#DBEEF3"></td>
</tr>
<tr height=17>
<td>Veg</td>
<td>0g</td>
<td></td>
<td style="color:red;background:#F2DDDC"></td>
<td style="color:blue;background:#DBE5F1"></td>
<td style="background:#D8D8D8"></td>
<td style="color:silver;background:#D8D8D8"></td>
<td style="color:brown;background:#DDD9C3"></td>
<td style="color:green;background:#EAF1DD"></td>
<td style="color:purple;background:#E5E0EC"></td>
<td style="background:#DBEEF3"></td>
</tr>
</table><p><span style="color: #ff00ff;">'_---Table made 02 April 2018 02.04.2018 21:55:52 ====Daily Foods Table End ======</span></p>

<p class=MsoNormal><o:p>&nbsp;</o:p></p>

<p class=MsoNormal><o:p>&nbsp;</o:p></p>

<p class=MsoNormal><b><span style='color:#D99594;mso-themecolor:accent2;
mso-themetint:153'>X <span class=SpellE>x</span> <span class=SpellE>x</span> <span
class=SpellE>x</span> <span class=SpellE>x</span> <o:p></o:p></span></b></p>

</div>

</body>

</html>

---

Just for my memory revision , in the macro I use ( e.g. xxxxx ) , this is the code line which adds my stuff ( which I have in a variable, MyLengthyStreaming ) so as to make DailyProtableFilled from DailyProtable

Code:

---

Let TotalFile = Replace(TotalFile, "<div class=WordSection1>", "<div class=WordSection1>" & vbCrLf & MyLengthyStreaming, 1, 1, vbTextCompare)

---

So we see what is going on – we are adding stuff at the word section.
Lets take a look now at the OP’s file …. In next post

_...continued from last post
Lets take a look now at the OP’s file


I will open it, save it as extension type .htm at some temporary place, close it, and then take a look at the .htm file produced with a text editor.
( Once again I will run a macro recording so as to get some coding for future reference )

This is the basic coding produced:

Code:

---

Sub Makro6()
 ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\"
 Documents.Open Filename:="""2. KEEP DUPLICATE RECORDS.docx""", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", DocumentDirection:=wdLeftToRight

 ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Temporary Folder\"
 ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
 ActiveWindow.View.Type = wdWebView
 ActiveDocument.Close
End Sub

---

Here is a look at part of the htm file
2. KEEP DUPLICATE RECORDS.txt : https://app.box.com/s/7ezpcmytjctxvqdodosys62nsdn80y45
_... see next post

_... continued

Code:

---

</o:shapelayout></xml><![endif]-->
</head>

<body lang=DE style='tab-interval:36.0pt'>

<div class=WordSection1>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;mso-outline-level:2;background:white;vertical-align:
baseline'><b><span lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>2. Keep Duplicate Records<o:p></o:p></span></b></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><u><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>Power Query</span></u><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'> lets you perform a series of steps
to transform your Excel data.<span style='mso-spacerun:yes'>  </span>One of the
steps it allows you to take is to<b> keep duplicate records</b>.<o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>We usually remove duplicate lines
but if we need to keep and check what the duplicates are, Excel allows us to do
that too!<o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>Let’s suppose you have this set of
data. You can see that the marked ones are duplicate values, let us keep them!<o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
style='font-size:12.0pt;font-family:"Times New Roman","serif";mso-fareast-font-family:
"Times New Roman";mso-ansi-language:DE;mso-fareast-language:DE;mso-no-proof:
yes'><!--[if gte vml 1]><v:shapetype id="_x0000_t75" coordsize="21600,21600"
 o:spt="75" o:preferrelative="t" path="m@4@5l@4@11@9@11@9@5xe" filled="f"
 stroked="f">
 <v:stroke joinstyle="miter"/>
 <v:formulas>
  <v:f eqn="if lineDrawn pixelLineWidth 0"/>
  <v:f eqn="sum @0 1 0"/>
  <v:f eqn="sum 0 0 @1"/>
  <v:f eqn="prod @2 1 2"/>
  <v:f eqn="prod @3 21600 pixelWidth"/>
  <v:f eqn="prod @3 21600 pixelHeight"/>
  <v:f eqn="sum @0 0 1"/>
  <v:f eqn="prod @6 1 2"/>
  <v:f eqn="prod @7 21600 pixelWidth"/>
  <v:f eqn="sum @8 21600 0"/>
  <v:f eqn="prod @7 21600 pixelHeight"/>
  <v:f eqn="sum @10 21600 0"/>
 </v:formulas>
 <v:path o:extrusionok="f" gradientshapeok="t" o:connecttype="rect"/>
 <o:lock v:ext="edit" aspectratio="t"/>
</v:shapetype><v:shape id="Picture_x0020_38" o:spid="_x0000_i1030" type="#_x0000_t75"
 alt="Keep Duplicates Using Power Query or Get &amp; Transform" style='width:122.25pt;
 height:121.5pt;visibility:visible;mso-wrap-style:square'>
 <v:imagedata src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image001.png"
  o:title="Keep Duplicates Using Power Query or Get &amp; Transform"/>
</v:shape><![endif]--><![if !vml]><img width=163 height=162
src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image002.jpg"
alt="Keep Duplicates Using Power Query or Get &amp; Transform" v:shapes="Picture_x0020_38"><![endif]></span><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'><o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><b><u><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>STEP 1</span></u></b><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>: Select your data and turn it into
an Excel Table by pressing the shortcut <b>Ctrl + T </b>or by going to<b>
Insert &gt; Table</b><o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
style='font-size:12.0pt;font-family:"Times New Roman","serif";mso-fareast-font-family:
"Times New Roman";mso-ansi-language:DE;mso-fareast-language:DE;mso-no-proof:
yes'><!--[if gte vml 1]><v:shape id="Picture_x0020_39" o:spid="_x0000_i1029"
 type="#_x0000_t75" alt="Keep Duplicates Using Power Query or Get &amp; Transform"
 style='width:105pt;height:132pt;visibility:visible;mso-wrap-style:square'>
 <v:imagedata src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image003.png"
  o:title="Keep Duplicates Using Power Query or Get &amp; Transform"/>
</v:shape><![endif]--><![if !vml]><img width=140 height=176
src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image004.jpg"
alt="Keep Duplicates Using Power Query or Get &amp; Transform" v:shapes="Picture_x0020_39"><![endif]></span><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'><o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'><o:p>&nbsp;</o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><b><u><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>STEP 2</span></u></b><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>: Go to <b><i>Power Query &gt; Excel
Data &gt; From Table</i>:</b><o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'><o:p>&nbsp;</o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><a
name="_GoBack"></a><span style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman";mso-ansi-language:DE;mso-fareast-language:
DE;mso-no-proof:yes'><!--[if gte vml 1]><v:shape id="Picture_x0020_41" o:spid="_x0000_i1028"
 type="#_x0000_t75" alt="Keep Duplicates Using Power Query or Get &amp; Transform"
 style='width:291pt;height:48pt;visibility:visible;mso-wrap-style:square'>
 <v:imagedata src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image005.png"
  o:title="Keep Duplicates Using Power Query or Get &amp; Transform"/>
</v:shape><![endif]--><![if !vml]><img width=388 height=64
src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image006.jpg"
alt="Keep Duplicates Using Power Query or Get &amp; Transform" v:shapes="Picture_x0020_41"><![endif]></span><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'><o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'><o:p>&nbsp;</o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><b><u><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>STEP 3: </span></u></b><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>This will open up the Power Query
Editor.<o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>Go to <b><i>Home &gt; Keep Rows &gt;
Keep Duplicates</i></b><o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
style='font-size:12.0pt;font-family:"Times New Roman","serif";mso-fareast-font-family:
"Times New Roman";mso-ansi-language:DE;mso-fareast-language:DE;mso-no-proof:
yes'><!--[if gte vml 1]><v:shape id="Picture_x0020_42" o:spid="_x0000_i1027"
 type="#_x0000_t75" alt="Keep Duplicates Using Power Query or Get &amp; Transform"
 style='width:198pt;height:163.5pt;visibility:visible;mso-wrap-style:square'>
 <v:imagedata src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image007.png"
  o:title="Keep Duplicates Using Power Query or Get &amp; Transform"/>
</v:shape><![endif]--><![if !vml]><img width=264 height=218
src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image008.jpg"
alt="Keep Duplicates Using Power Query or Get &amp; Transform" v:shapes="Picture_x0020_42"><![endif]></span><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'><o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'><o:p>&nbsp;</o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><b><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>STEP 4: </span></b><span lang=EN-US
style='font-size:12.0pt;font-family:"Times New Roman","serif";mso-fareast-font-family:
"Times New Roman"'>Click <b>Close &amp; Load</b> from the <b>Home</b> tab and
this will <b>open up a brand new worksheet</b> in your Excel workbook with the
updated table.<o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
style='font-size:12.0pt;font-family:"Times New Roman","serif";mso-fareast-font-family:
"Times New Roman";mso-ansi-language:DE;mso-fareast-language:DE;mso-no-proof:
yes'><!--[if gte vml 1]><v:shape id="Picture_x0020_43" o:spid="_x0000_i1026"
 type="#_x0000_t75" alt="Keep Duplicates Using Power Query or Get &amp; Transform"
 style='width:115.5pt;height:126.75pt;visibility:visible;mso-wrap-style:square'>
 <v:imagedata src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image009.png"
  o:title="Keep Duplicates Using Power Query or Get &amp; Transform"/>
</v:shape><![endif]--><![if !vml]><img width=154 height=169
src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image010.jpg"
alt="Keep Duplicates Using Power Query or Get &amp; Transform" v:shapes="Picture_x0020_43"><![endif]></span><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'><o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'>You now have your new table with the
duplicate rows kept!<o:p></o:p></span></p>

<p class=MsoNormal style='margin-bottom:0cm;margin-bottom:.0001pt;text-align:
justify;line-height:normal;background:white;vertical-align:baseline'><span
style='font-size:12.0pt;font-family:"Times New Roman","serif";mso-fareast-font-family:
"Times New Roman";mso-ansi-language:DE;mso-fareast-language:DE;mso-no-proof:
yes'><!--[if gte vml 1]><v:shape id="Picture_x0020_44" o:spid="_x0000_i1025"
 type="#_x0000_t75" alt="Keep Duplicates Using Power Query or Get &amp; Transform"
 style='width:89.25pt;height:70.5pt;visibility:visible;mso-wrap-style:square'>
 <v:imagedata src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image011.png"
  o:title="Keep Duplicates Using Power Query or Get &amp; Transform"/>
</v:shape><![endif]--><![if !vml]><img width=119 height=94
src="2.%20KEEP%20DUPLICATE%20RECORDS-Dateien/image012.jpg"
alt="Keep Duplicates Using Power Query or Get &amp; Transform" v:shapes="Picture_x0020_44"><![endif]></span><span
lang=EN-US style='font-size:12.0pt;font-family:"Times New Roman","serif";
mso-fareast-font-family:"Times New Roman"'><o:p></o:p></span></p>

<p class=MsoNormal><span lang=EN-US><o:p>&nbsp;</o:p></span></p>

</div>

</body>

</html>

---

These are the files and folders produced Files and Folders from OPs file saved as htm.jpg
https://i.postimg.cc/sGFkH5ZX/Files-...ved-as-htm.jpg

Here is the actual file as seen in word
OPs sample file.JPG
https://i.postimg.cc/1g1hpq8f/OPs-sample-file.jpg

---

And it might be interesting to see the OPs file seen in the text format, if I delete all that stuff seen , making a new file, 2. KEEP DUPLICATE RECORDS All stuff removed.htm
OPs sample file All stuff removed.jpg
https://i.postimg.cc/jn2dG7QR/OPs-sa...ff-removed.jpg

This is what that file looks like in the text format view:

Code:

---

        mso-ansi-language:EN-US;
        mso-fareast-language:EN-US;}
</style>
<![endif]--><!--[if gte mso 9]><xml>
 <o:shapedefaults v:ext="edit" spidmax="5122"/>
</xml><![endif]--><!--[if gte mso 9]><xml>
 <o:shapelayout v:ext="edit">
  <o:idmap v:ext="edit" data="1"/>
 </o:shapelayout></xml><![endif]-->
</head>

<body lang=DE style='tab-interval:36.0pt'>

<div class=WordSection1>

<p class=MsoNormal><span style='mso-ansi-language:DE'><o:p>&nbsp;</o:p></span></p>

</div>

</body>

</html>

---

2. KEEP DUPLICATE RECORDS All stuff removed.txt: https://app.box.com/s/f00nejo3edwygrz6jq3u8zvny7ceakp7

The HTML text of the content – our stuff as seen in HTML coiding.
The last few postings seem to tell us that the content we are interested in, that is to say what we put in the document seems to lie in between the HTML text of
<div class=WordSection1>
And something of the form
<p class=MsoNormal><span lang=EN-US><o:p>&nbsp;</o:p></span></p>

</div>

Or
<p class=MsoNormal><o:p>&nbsp;</o:p></p>

<p class=MsoNormal><o:p>&nbsp;</o:p></p>

<p class=MsoNormal><b><span style='color:#D99594;mso-themecolor:accent2;
mso-themetint:153'>X <span class=SpellE>x</span> <span class=SpellE>x</span> <span
class=SpellE>x</span> <span class=SpellE>x</span> <o:p></o:p></span></b></p>

</div>
The end point might not be too clear, but if we take all the text from <div class=WordSection1> to </div> then it looks like we will catch all of “our stuff”

In that text of our stuff we see 6 bits with a .jpg and 6 bits with .png
Comparing that with the typical files produced .._
_.. , and considering that the document has clearly 6 images.._
https://i.postimg.cc/CRtZzk0D/6-images-in-document.jpg
_.. we see that we appear to get for each image a .jpg and a .png
https://i.postimg.cc/McQnRHZL/6-x-2-...-png-pairs.jpg

( By the way, We can see some info from Microsoft on this …. To extract embedded images from a Word document …… Save As ….. Web Page (*.htm; *.html)
Images will be extracted from the document and placed in the folder named <DocumentName>_files in the same location as the saved web page .
https://support.microsoft.com/en-us/...c-3eeb284af36b
http://web.archive.org/web/202103021...c-3eeb284af36b )

Macro to get this image info.
It’s not too difficult to write a macro to list those files
Example
VBA seems to recognise in the following macro type both .htm and .txt files as just long strings of text.
So I can do a macro to import that text string, then do some simple string manipulation to get the text bits looking like .jpg or .png file names

I will do that in the next post

Macro to get this image info.
It’s not too difficult to write a macro to list those files
Example, Sub ListThe_jpgs_pngs()
VBA seems to recognise in the following macro type both .htm and .txt files as just long strings of text, so I can equally use my .htm or .txt file version of a file like the OPs 2. KEEP DUPLICATE RECORDS
The macro below imports that text string, then does some simple string manipulation to get the text bits looking like .jpg or .png file names

Code:

---

Sub ListThe_jpgs_pngs()
Rem 1 get the entire documant as a long text string in variable,  TotalDoc
Dim FileNum As Long: Let FileNum = FreeFile(1)    ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function    http://web.archive.org/web/20210914055920/https://docs.microsoft.com/en-us/office/vba/Language/Reference/User-Interface-Help/freefile-function
Dim PathAndFileName As String, TotalDoc As String
 Let PathAndFileName = ThisWorkbook.Path & "\" & "2. KEEP DUPLICATE RECORDS.htm" '
  Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
    TotalDoc = Space(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
    Get #FileNum, , TotalDoc
  Close #FileNum
Rem 2 Our text stuff content
Dim OurStuffTxt As String, Strt As Long, Stp As Long
 Let Strt = InStr(1, TotalDoc, "<div class=WordSection1>", vbBinaryCompare) + 25  '  +25 takes us to the end of  "<div class=WordSection1>"
 Let Stp = InStr(Strt, TotalDoc, "</div>", vbBinaryCompare)
 Let OurStuffTxt = Mid(TotalDoc, Strt, Stp - Strt)
Rem 3 getting at the  .jpgs
Dim Pos_jpg As Long
'3a  The first position, if there is one.  If there isn't one then the next code line will return  0
 Let Pos_jpg = InStr(1, OurStuffTxt, ".jpg", vbBinaryCompare) '  from the start of out stuff text string , 1 , we look for a  .jpg
    Do While Pos_jpg <> 0  '  I will keep picking out the  file  names  as long as I find another
    '3b  if I have a  .jpg    , I will keep adding the  name  to a long string.  Each file name will be seperated by a  new line , ( which in VBA caan be represented in the text string by the two "invisible" characters  carriage return, vbCr  and  line feed, vbLf  - these two thinbgs are a throw back to old days when in the text string you had something to tell the printer to go back to the left ( carriage return )  and  click the spindle up a line/ feed up a new line of paper,  line feed
    Let Strt = InStrRev(OurStuffTxt, "/", Pos_jpg, vbBinaryCompare) ' looking backwards from position  Pos_jpg  to get  at  like  in  stuff  like    ............%20RECORDS-Dateien/image004.jpg"
    Dim Jpgs As String
    Let Jpgs = Jpgs & Mid(OurStuffTxt, Strt + 1, (Pos_jpg + (4 - 1)) - Strt) & vbCr & vbLf  '  A bit of string manipulatzion to get the  jpg  file name text  then add a bit to give the next line for adding the next one
   
    Let Pos_jpg = InStr(Pos_jpg + 4, OurStuffTxt, ".jpg", vbBinaryCompare) '  i trx again to find the next  .jpg  if there is one.  This is similar to the code line  looking for the first  .jpg    The difference is that  I start looking at the position of the last one so as not to find one that I already considered
    Loop ' While Pos_jpg <> 0
 MsgBox prompt:=".jpg names in string" & vbCr & vbLf & vbCr & vbLf & Jpgs
 Debug.Print ".jpg names in string" & vbCr & vbLf & vbCr & vbLf & Jpgs & vbCr & vbLf & vbCr & vbLf  '  same output again in  Immediate window  ( Ctrl+g  to get it up when looking in VB editor )  add a couple of lines to seperate it from the next  png section

Rem 4 getting at the  .pngs
Dim Pos_png As Long
'4a
 Let Pos_png = InStr(1, OurStuffTxt, ".png", vbBinaryCompare) '
    Do While Pos_png <> 0  '
    '4b
    Let Strt = InStrRev(OurStuffTxt, "/", Pos_png, vbBinaryCompare)
    Dim Pngs As String
    Let Pngs = Pngs & Mid(OurStuffTxt, Strt + 1, (Pos_png + (4 - 1)) - Strt) & vbCr & vbLf  '
   
    Let Pos_png = InStr(Pos_png + 4, OurStuffTxt, ".png", vbBinaryCompare) '  i trx again to find the next  .jpg  if there is one.  This is similar to the code line  looking for the first  .jpg    The difference is that  I start looking at the position of the last one so as not to find one that I already considered
    Loop ' While Pos_png <> 0
 MsgBox prompt:=".png names in string" & vbCr & vbLf & vbCr & vbLf & Pngs
 Debug.Print ".png names in string" & vbCr & vbLf & vbCr & vbLf & Pngs

End Sub

---

Here is the typical output
TypicalOutputFrom Sub ListThe_jpgs_pngs()
https://i.postimg.cc/G8pjf1pF/Typica...-jpgs-pngs.jpg

Code:

---

.jpg names in string

image002.jpg
image004.jpg
image006.jpg
image008.jpg
image010.jpg
image012.jpg



.png names in string

image001.png
image003.png
image005.png
image007.png
image009.png
image011.png

---

Saving Word doc containing images, as .htm produces a folder with images in it
So we have established that saving Word doc containing images, as .htm produces a folder with images in it , and we can even find a bit of Microsoft documentation about it

As Microsoft have “wired it” to do this, we might find some useful information in the arguments Iin the Save As code line

This is the OPs original
ActiveDocument.SaveAs strPath & "" & strDocumentName, wdFormatHTML, , , , , True
In detail:
strPath & "" & strDocumentName,
wdFormatHTML,
,
,
,
,
True

Here for comparison what the macro recorder typically gave me:
ActiveDocument.SaveAs FileName:="docHTML2.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
In detail:
FileName:="docHTML2.htm",
FileFormat:=wdFormatHTML,
LockComments:= False,
Password:="",
AddToRecentFiles:= True,
WritePassword:="",
ReadOnlyRecommended:= False,
EmbedTrueTypeFonts:= False,
SaveNativePictureFormat:= False,
SaveFormsData:= False,
SaveAsAOCELetter:=False

Unnamed arguments, as used by the OP, must go in correct order. Named argumenzts, as I am using, do not have to go in order, but as far as I am aware the macro recorder does
_ give them in order, and
_ usually gives a lot of the arguments in their default values.
So we can re write the equivalent named argument version of the OPs code line thus:
FileName:= strPath & "" & strDocumentName,
FileFormat:= wdFormatHTML,
LockComments:=False,
Password:="",
AddToRecentFiles:=True,
WritePassword:="",
ReadOnlyRecommended:= True


Conclusion here is that we are more or less doiung the same thing, - a recommendation for read only likely just causes some extra warnings when the file is opened. That is of little concern to our issues

https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=15643&viewfull=1#post15643

Word File Save As ___.htm

At this stage, I would like to check what happens in terms of produced files and folders for some different files

The OP’s file
_ as he gave it, named 2. KEEP DUPLICATE RECORDS.docx
_ name changed to 2_ KEEP DUPLICATE RECORDS.docx
_ name changed to the Office 97 – 2003 format 2_ KEEP DUPLICATE RECORDS.doc
_ the file with all images removed
_ the file with everything removed

_ a new virgin file


I will do all that programmatically, for convenience and consistency since I might repeat the experiment in different Excel versions. ( So far most of my work is in Office 2007 )


As a prelude to that, to help get some syntaxes, I will do some of that manually first, whilst running a macro recorder

This is approximately what the macro recorder gave me. I have simplified it a bit and added some 'comments

Code:

---

Sub Makro7()
'
' Makro7 Makro  https://excelfox.com/forum/showthread.php/2348-Just-Testing-Passing-info-between-Word-and-Excel?p=15643&viewfull=1#post15643
'
'  OPs  original file
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\"
    Documents.Open Filename:="""2. KEEP DUPLICATE RECORDS.docx""", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", DocumentDirection:=wdLeftToRight
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Original OP File\"
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close ' close the  .htm file
   
'  OPs file with dot in name changed to underscore
    RecentFiles(3).Open
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Ops File with dot in name changed to underscore\"
    ActiveDocument.SaveAs Filename:="2_ KEEP DUPLICATE RECORDS.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2_ KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close  ' close the  .htm file
   
' File in Office 97 - 2003 format
    RecentFiles(3).Open
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Ops file in 97 -2003 format\"
    ActiveDocument.SaveAs Filename:="2_ KEEP DUPLICATE RECORDS.doc", FileFormat:=wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2_ KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close ' close the  .htm file
   
' Ops file no images
    RecentFiles(3).Open
    Selection.MoveDown Unit:=wdLine, Count:=6
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=4
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=4
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=4
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Ops File no images\"
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS no images.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS no images.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close ' close the  .htm file

' Empty OP file
    RecentFiles(3).Open
    Selection.WholeStory
    Selection.TypeBackspace
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\OPs file empty\"
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS empty.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS empty.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS empty.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close  ' close the  .htm file

'  Virgin file
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0 ' make file
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Virgin empty file\"
    ActiveDocument.SaveAs Filename:="Dok2.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="Dok2.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close  ' close the  .htm file
End Sub

---

Here is the files produced

' OPs original file

https://i.postimg.cc/Sj6zhRXK/OPs-original-file.jpg

' OPs file with dot in name changed to underscore
https://i.postimg.cc/GTxBJg0D/OPs-fi...underscore.jpg

' File in Office 97 - 2003 format
https://i.postimg.cc/62gsbBKJ/File-i...003-format.jpg

' Ops file no images
https://i.postimg.cc/ph85yXqq/Ops-fi...es-removed.jpg

' Empty OP file
https://i.postimg.cc/0KsMSR4x/Ops-file-emptied.jpg

' Virgin file
https://i.postimg.cc/sMDWKzgg/Virgin-File.jpg




We seem to have some inconstancy with the files and folders produced by the original OP macro, ( https://excelfox.com/forum/showthrea...ll=1#post15623 ) , so in the next post I had better check that first..
The inconstancy seems to be that a .htm file was not produced – instead some strange file was there , one with no extension shown, and the new file folder produced did not have the full name 2. KEEP DUPLICATE RECORDS-Files , instead it came out as 2-Files
Attachment 3625Attachment 3626

https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21212&viewfull=1#post21212

Word File Save As ___.htm

At this stage, I would like to check what happens in terms of produced files and folders for some different files

The OP’s file
_ as he gave it, named 2. KEEP DUPLICATE RECORDS.docx
_ name changed to 2_ KEEP DUPLICATE RECORDS.docx
_ name changed to the Office 97 – 2003 format 2_ KEEP DUPLICATE RECORDS.doc
_ the file with all images removed
_ the file with everything removed

_ a new virgin file


I will do all that programmatically, for convenience and consistency since I might repeat the experiment in different Excel versions. ( So far most of my work is in Office 2007 )


As a prelude to that, to help get some syntaxes, I will do some of that manually first, whilst running a macro recorder

This is approximately what the macro recorder gave me. I have simplified it a bit and added some 'comments

Code:

---

Sub Makro7()
'
' Makro7 Makro  https://excelfox.com/forum/showthread.php/2348-Just-Testing-Passing-info-between-Word-and-Excel?p=15643&viewfull=1#post15643
'
'  OPs  original file
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\"
    Documents.Open Filename:="""2. KEEP DUPLICATE RECORDS.docx""", ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="", DocumentDirection:=wdLeftToRight
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Original OP File\"
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close ' close the  .htm file
   
'  OPs file with dot in name changed to underscore
    RecentFiles(3).Open
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Ops File with dot in name changed to underscore\"
    ActiveDocument.SaveAs Filename:="2_ KEEP DUPLICATE RECORDS.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2_ KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close  ' close the  .htm file
   
' File in Office 97 - 2003 format
    RecentFiles(3).Open
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Ops file in 97 -2003 format\"
    ActiveDocument.SaveAs Filename:="2_ KEEP DUPLICATE RECORDS.doc", FileFormat:=wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2_ KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close ' close the  .htm file
   
' Ops file no images
    RecentFiles(3).Open
    Selection.MoveDown Unit:=wdLine, Count:=6
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=4
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=4
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=4
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.MoveDown Unit:=wdLine, Count:=2
    Selection.TypeBackspace
    Selection.TypeBackspace
    Selection.TypeBackspace
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Ops File no images\"
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS no images.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS no images.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close ' close the  .htm file

' Empty OP file
    RecentFiles(3).Open
    Selection.WholeStory
    Selection.TypeBackspace
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\OPs file empty\"
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS empty.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS empty.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="2. KEEP DUPLICATE RECORDS empty.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close  ' close the  .htm file

'  Virgin file
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0 ' make file
    ChangeFileOpenDirectory "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\Virgin empty file\"
    ActiveDocument.SaveAs Filename:="Dok2.docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveDocument.SaveAs Filename:="Dok2.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
    ActiveWindow.View.Type = wdWebView
    ActiveDocument.Close  ' close the  .htm file
End Sub

---

Here is the files produced

' OPs original file

https://i.postimg.cc/Sj6zhRXK/OPs-original-file.jpg

' OPs file with dot in name changed to underscore
https://i.postimg.cc/GTxBJg0D/OPs-fi...underscore.jpg

' File in Office 97 - 2003 format
https://i.postimg.cc/62gsbBKJ/File-i...003-format.jpg

' Ops file no images
https://i.postimg.cc/ph85yXqq/Ops-fi...es-removed.jpg

' Empty OP file
https://i.postimg.cc/0KsMSR4x/Ops-file-emptied.jpg

' Virgin file
https://i.postimg.cc/sMDWKzgg/Virgin-File.jpg




We seem to have some inconstancy with the files and folders produced by the original OP macro, ( https://excelfox.com/forum/showthrea...ll=1#post15623 ) , so in the next post I had better check that first..
The inconstancy seems to be that a .htm file was not produced – instead some strange file was there , one with no extension shown, and the new file folder produced did not have the full name 2. KEEP DUPLICATE RECORDS-Files , instead it came out as 2-Files
Attachment 3625Attachment 3626

https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=15644&viewfull=1#post15644



We seem to have some inconstancy with the files and folders produced by the original OP macro, ( https://excelfox.com/forum/showthrea...ll=1#post15623 ) , and those in the last post, so I will look into that here.
The inconstancy seems to be that a .htm file was not produced by the original OP macro– instead some strange file was there , one with no extension shown, and the new file folder produced did not have the full name 2. KEEP DUPLICATE RECORDS-Files , instead it came out as 2-Files
Attachment 3625Attachment 3626


I had a little play around, and it looks I have tracked down the problem.
To demo:-
The following macro doers three Save As .htm code lines. The first does something similar to the original OP’s
The second has replaced the first _ . _ in the file name with a _ _ _
The final code line does the code line what the macro recorder gave.

Looking at the three results, it is obvious what’s probably going on: The missing .htm in the OP’s code line is causing the problem. Although we are saving as FileFormat:=wdFormatHTML , it gets no extension on the file name.
Without knowing exactly how Microsoft organised the working things, I cannot say exactly what is going on, but then file shown with no extension is clearly the htm file – we can prove this by opening with word, and it appears exactly the same as any of the 2. KEEP DUPLICATE RECORDS.htm files that we have been producing. The little discrepancy fact that the folder containing the images gets a name like 2-xxxx instead of like 2-2. KEEP DUPLICATE RECORDS xxxx , is probably because the workings are somehow mistaking the first _ . _ as the extension _ . _.
That discrepancy does not appear when we replace the _ . _ with some other character, as in the second Save As .htm code line
In fact, we also get a normal .htm extension as well. So this suggests that the workings are somehow confusing that first _ . _ as meaning that the extension is _ KEEP DUPLICATE RECORDS


So the conclusion is:
Most important you should add the .htm extension on the given file name.
It is probably good practice to not have an extra _ . _ in any file name


Results:
ActiveDocument.SaveAs FileName:=strPath & "Temp1" & "" & "2. KEEP DUPLICATE RECORDS", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:= True
https://i.postimg.cc/dkKVKs3f/Temp-1.jpg

ActiveDocument.SaveAs FileName:=strPath & "Temp2" & "" & "2_ KEEP DUPLICATE RECORDS", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False
https://i.postimg.cc/qtKvYhJn/Temp-2.jpg

ActiveDocument.SaveAs FileName:=TempFolder & "" & "2. KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False ', EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
https://i.postimg.cc/gxQ0NqWm/Temp-3.jpg

Code:

---

Sub OPsFileMakesStrangeFiles()  '  https://excelfox.com/forum/showthread.php/2348-Just-Testing-Passing-info-between-Word-and-Excel?p=15644&viewfull=1#post15644
Dim strPath As String: Let strPath = "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\"
 Documents.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\2. KEEP DUPLICATE RECORDS.docx" ' This wont error if document file is already open
 
    If Dir(strPath & "Temp1", vbDirectory) = "" Then MkDir strPath & "Temp1"
 ActiveDocument.SaveAs Filename:=strPath & "Temp1" & "\" & "2. KEEP DUPLICATE RECORDS", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=True
 ActiveDocument.Close
   
 Documents.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\2. KEEP DUPLICATE RECORDS.docx" ' This wont error if document file is already open
    If Dir(strPath & "Temp2", vbDirectory) = "" Then MkDir strPath & "Temp2"
 ActiveDocument.SaveAs Filename:=strPath & "Temp2" & "\" & "2_ KEEP DUPLICATE RECORDS", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False
 ActiveDocument.Close
 
 Documents.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\2. KEEP DUPLICATE RECORDS.docx" ' This wont error if document file is already open
    If Dir(strPath & "Temp3", vbDirectory) = "" Then MkDir strPath & "Temp3"
 ActiveDocument.SaveAs Filename:=TempFolder & "\" & "2. KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False ', EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
 ActiveDocument.Close
End Sub

---

https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21213&viewfull=1#post21213




We seem to have some inconstancy with the files and folders produced by the original OP macro, ( https://excelfox.com/forum/showthrea...ll=1#post15623 ) , and those in the last post, so I will look into that here.
The inconstancy seems to be that a .htm file was not produced by the original OP macro– instead some strange file was there , one with no extension shown, and the new file folder produced did not have the full name 2. KEEP DUPLICATE RECORDS-Files , instead it came out as 2-Files
Attachment 3625Attachment 3626


I had a little play around, and it looks I have tracked down the problem.
To demo:-
The following macro doers three Save As .htm code lines. The first does something similar to the original OP’s
The second has replaced the first _ . _ in the file name with a _ _ _
The final code line does the code line what the macro recorder gave.

Looking at the three results, it is obvious what’s probably going on: The missing .htm in the OP’s code line is causing the problem. Although we are saving as FileFormat:=wdFormatHTML , it gets no extension on the file name.
Without knowing exactly how Microsoft organised the working things, I cannot say exactly what is going on, but then file shown with no extension is clearly the htm file – we can prove this by opening with word, and it appears exactly the same as any of the 2. KEEP DUPLICATE RECORDS.htm files that we have been producing. The little discrepancy fact that the folder containing the images gets a name like 2-xxxx instead of like 2-2. KEEP DUPLICATE RECORDS xxxx , is probably because the workings are somehow mistaking the first _ . _ as the extension _ . _.
That discrepancy does not appear when we replace the _ . _ with some other character, as in the second Save As .htm code line
In fact, we also get a normal .htm extension as well. So this suggests that the workings are somehow confusing that first _ . _ as meaning that the extension is _ KEEP DUPLICATE RECORDS


So the conclusion is:
Most important you should add the .htm extension on the given file name.
It is probably good practice to not have an extra _ . _ in any file name


Results:
ActiveDocument.SaveAs FileName:=strPath & "Temp1" & "" & "2. KEEP DUPLICATE RECORDS", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:= True
https://i.postimg.cc/dkKVKs3f/Temp-1.jpg

ActiveDocument.SaveAs FileName:=strPath & "Temp2" & "" & "2_ KEEP DUPLICATE RECORDS", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False
https://i.postimg.cc/qtKvYhJn/Temp-2.jpg

ActiveDocument.SaveAs FileName:=TempFolder & "" & "2. KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False ', EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
https://i.postimg.cc/gxQ0NqWm/Temp-3.jpg

Code:

---

Sub OPsFileMakesStrangeFiles()  '  https://excelfox.com/forum/showthread.php/2348-Just-Testing-Passing-info-between-Word-and-Excel?p=15644&viewfull=1#post15644
Dim strPath As String: Let strPath = "F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\"
 Documents.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\2. KEEP DUPLICATE RECORDS.docx" ' This wont error if document file is already open
 
    If Dir(strPath & "Temp1", vbDirectory) = "" Then MkDir strPath & "Temp1"
 ActiveDocument.SaveAs Filename:=strPath & "Temp1" & "\" & "2. KEEP DUPLICATE RECORDS", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=True
 ActiveDocument.Close
   
 Documents.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\2. KEEP DUPLICATE RECORDS.docx" ' This wont error if document file is already open
    If Dir(strPath & "Temp2", vbDirectory) = "" Then MkDir strPath & "Temp2"
 ActiveDocument.SaveAs Filename:=strPath & "Temp2" & "\" & "2_ KEEP DUPLICATE RECORDS", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False
 ActiveDocument.Close
 
 Documents.Open Filename:="F:\Excel0202015Jan2016\ExcelFox\Word\prkhan56\2. KEEP DUPLICATE RECORDS.docx" ' This wont error if document file is already open
    If Dir(strPath & "Temp3", vbDirectory) = "" Then MkDir strPath & "Temp3"
 ActiveDocument.SaveAs Filename:=TempFolder & "\" & "2. KEEP DUPLICATE RECORDS.htm", FileFormat:=wdFormatHTML, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False ', EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False
 ActiveDocument.Close
End Sub

---

https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=15645&viewfull=1#post15645




https://i.postimg.cc/L61Y4HcP/Aufzeichnen2.jpg


https://i.postimg.cc/CK7CSF30/Aufzeichnen3.jpg

https://i.postimg.cc/WbKXH6rv/Aufzeichnen4.jpgupload pictures

https://i.postimg.cc/WbKXH6rv/Aufzeichnen4.jpg


test

Hi
Mein Deutsch nicht so gut ist, da ich Engländer bin, aber ich werde es versuchen...
Dies hängt mit einigen anderen ungelösten Dingen zusammen ( https://www.dsl-forum.de/threads/251...line-verbunden
https://telekomhilft.telekom.de/t5/T...s/td-p/5342695 )
Seit etwa einem Monat funktioniert meine Internetverbindung nicht mehr. Anfangs dachte man, es könnte ein Problem mit meinem alten Speedport W504V-Router sein.
Ich war daran interessiert, weiter zu experimentieren, um diesen Verdacht zu bestätigen.

Die Ergebnisse sind etwas seltsam:

Ich habe noch ein paar andere Speedport W504Vs bekommen, die normal funktionierten, vor sie nicht mehr benutz, bzw. nicht mehr gebraucht war, und auch ein neues originalverpacktes, das nie benutzt wurde.
Sie weisen alle das gleiche Problem auf wie ursprünglich bei meinem alten Speedport W504V: Sie verbinden sich alle erfolgreich, gehen online, aber das Internet funktioniert nicht und sie antworten weder auf 192.168.2.1 noch auf https://speedport.ip in der Adressleiste
Hier sind typische Ergebnisse einer erfolgreichen Verbindung für eine direkte LAN-Kabelverbindung:
https://i.postimg.cc/8CKFTQzM/Speedp...-LAN-Kable.jpg
und hier sind typische Ergebnisse für eine erfolgreiche WLAN-Verbindung
https://i.postimg.cc/fRsSKfPt/First-...-Connected.jpg
https://i.postimg.cc/FRYYRWYq/First-...ssel-Geben.jpg
https://i.postimg.cc/TYgWg4tv/First-...-Connected.jpg
https://i.postimg.cc/VNLryLmz/First-...ed-working.jpg
Aber danach bekommt man kein funktionierendes Internet, und beim IP 192.168.2.1 oder https://speedport.ip in die Adresszeile eingebe, kommt nur "Fehler: Netzwerk-Zeitüberschreitung - Der Server unter speedport.ip braucht zu lange, um eine Antwort zu senden." Egal mit welchem Browser oder Computer

Das Überprüfen von Dingen wie ipconfig usw. bestätigt alle Gateway 192.168.2.1, wie es für den Speedport erwartet wird

Der ganz neue Speedport reagierte bei der ersten Verbindung etwas anders, wie es sich gehört: Ein neuer Speedport bewirkt ein anfängliches Öffnen eines Browser-Tabs direkt beim anfänglichen Einrichtungsvorgang:
https://i.postimg.cc/CMJGdtrP/New-Sp...connection.jpg
https://i.postimg.cc/Xq2dhGyS/New-Sp...re-warning.jpg
https://i.postimg.cc/7hPSmMhn/New-Sp...figuration.jpg

Aber das scheitert beim ersten Schritt: Ich tippe hier das richtige Passwort ein, aber ich bekomme eine Fehlermeldung und komme nicht weiter.
https://i.postimg.cc/FRVjynrK/New-Sp...t-Password.jpg


Was das Ganze noch seltsamer macht, ist, dass ich einige alte Speedport W723s habe und sie alle normal funktionieren, mir ein funktionierendes Internet geben und auch wie erwartet reagieren, wenn sie 192.168.2.1 oder https://speedport.ip in die Adressleiste eingeben

Andere Router, die ich habe, funktionieren auch normal.

Ich habe meine Experimente mit vielen verschiedenen Computern mit unterschiedlichen Betriebssystemen wiederholt und die Ergebnisse sind immer gleich.

Es ist nicht möglich, dass alle meine Speedport W504v kaputt sind. Ich gehe davon aus, dass sie alle so funktionieren, wie sie ursprünglich entwickelt wurden.
Es scheint, dass etwas Seltsames passiert ist, so dass kein Speedport W504V mehr funktioniert???

Habe die Telekom eine grundlegende Änderung vorgenommen, wonach ein Speedport W504V nun nie mehr funktioniert???


Alan
Direct link for forum
[url=https://postimages.org/][img]https://i.postimg.cc/QC7swWy4/Here-Excel-forum-colors-ohne-rand.jpg[/img][/url]

[url=https://postimages.org/][img]https://i.postimg.cc/7PJxfpZ3/Here-Excel-fox-colors-ohne-rand.jpg[/img][/url]

now change link to post imagers to the link you want it to got to

https://i.postimg.cc/QC7swWy4/Here-E...-ohne-rand.jpg or https://i.postimg.cc/7PJxfpZ3/Here-E...-ohne-rand.jpg

Hello Chris, ( and Stuart )
In Excel things occasionally go out of whack in my VB Editor and I am buggered if I can ever find a way to get them back normally using any conventional method. Usually the docking of windows getting corrupted has been to blame.
So far the sledgehammer approach explained https://i.postimg.cc/QC7swWy4/Here-E...-ohne-rand.jpg has always put the VB Editor back to normal for me.
( In case that old post link does not work, or they insist on you logging in and you don’t want to, I just put a copy of that post https://i.postimg.cc/7PJxfpZ3/Here-E...-ohne-rand.jpg for you )

( you might need to look at a slightly different path in the registry. Someone else said they found it here: Computer\HKEY_CURRENT_USER\Software\Microsoft\VBA\ 7.1\Common

Alan

https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21214&viewfull=1#post21214




https://i.postimg.cc/L61Y4HcP/Aufzeichnen2.jpg


https://i.postimg.cc/CK7CSF30/Aufzeichnen3.jpg

https://i.postimg.cc/WbKXH6rv/Aufzeichnen4.jpgupload pictures

https://i.postimg.cc/WbKXH6rv/Aufzeichnen4.jpg


test

Hi
Mein Deutsch nicht so gut ist, da ich Engländer bin, aber ich werde es versuchen...
Dies hängt mit einigen anderen ungelösten Dingen zusammen ( https://www.dsl-forum.de/threads/251...line-verbunden
https://telekomhilft.telekom.de/t5/T...s/td-p/5342695 )
Seit etwa einem Monat funktioniert meine Internetverbindung nicht mehr. Anfangs dachte man, es könnte ein Problem mit meinem alten Speedport W504V-Router sein.
Ich war daran interessiert, weiter zu experimentieren, um diesen Verdacht zu bestätigen.

Die Ergebnisse sind etwas seltsam:

Ich habe noch ein paar andere Speedport W504Vs bekommen, die normal funktionierten, vor sie nicht mehr benutz, bzw. nicht mehr gebraucht war, und auch ein neues originalverpacktes, das nie benutzt wurde.
Sie weisen alle das gleiche Problem auf wie ursprünglich bei meinem alten Speedport W504V: Sie verbinden sich alle erfolgreich, gehen online, aber das Internet funktioniert nicht und sie antworten weder auf 192.168.2.1 noch auf https://speedport.ip in der Adressleiste
Hier sind typische Ergebnisse einer erfolgreichen Verbindung für eine direkte LAN-Kabelverbindung:
https://i.postimg.cc/8CKFTQzM/Speedp...-LAN-Kable.jpg
und hier sind typische Ergebnisse für eine erfolgreiche WLAN-Verbindung
https://i.postimg.cc/fRsSKfPt/First-...-Connected.jpg
https://i.postimg.cc/FRYYRWYq/First-...ssel-Geben.jpg
https://i.postimg.cc/TYgWg4tv/First-...-Connected.jpg
https://i.postimg.cc/VNLryLmz/First-...ed-working.jpg
Aber danach bekommt man kein funktionierendes Internet, und beim IP 192.168.2.1 oder https://speedport.ip in die Adresszeile eingebe, kommt nur "Fehler: Netzwerk-Zeitüberschreitung - Der Server unter speedport.ip braucht zu lange, um eine Antwort zu senden." Egal mit welchem Browser oder Computer

Das Überprüfen von Dingen wie ipconfig usw. bestätigt alle Gateway 192.168.2.1, wie es für den Speedport erwartet wird

Der ganz neue Speedport reagierte bei der ersten Verbindung etwas anders, wie es sich gehört: Ein neuer Speedport bewirkt ein anfängliches Öffnen eines Browser-Tabs direkt beim anfänglichen Einrichtungsvorgang:
https://i.postimg.cc/CMJGdtrP/New-Sp...connection.jpg
https://i.postimg.cc/Xq2dhGyS/New-Sp...re-warning.jpg
https://i.postimg.cc/7hPSmMhn/New-Sp...figuration.jpg

Aber das scheitert beim ersten Schritt: Ich tippe hier das richtige Passwort ein, aber ich bekomme eine Fehlermeldung und komme nicht weiter.
https://i.postimg.cc/FRVjynrK/New-Sp...t-Password.jpg


Was das Ganze noch seltsamer macht, ist, dass ich einige alte Speedport W723s habe und sie alle normal funktionieren, mir ein funktionierendes Internet geben und auch wie erwartet reagieren, wenn sie 192.168.2.1 oder https://speedport.ip in die Adressleiste eingeben

Andere Router, die ich habe, funktionieren auch normal.

Ich habe meine Experimente mit vielen verschiedenen Computern mit unterschiedlichen Betriebssystemen wiederholt und die Ergebnisse sind immer gleich.

Es ist nicht möglich, dass alle meine Speedport W504v kaputt sind. Ich gehe davon aus, dass sie alle so funktionieren, wie sie ursprünglich entwickelt wurden.
Es scheint, dass etwas Seltsames passiert ist, so dass kein Speedport W504V mehr funktioniert???

Habe die Telekom eine grundlegende Änderung vorgenommen, wonach ein Speedport W504V nun nie mehr funktioniert???


Alan
Direct link for forum
[url=https://postimages.org/][img]https://i.postimg.cc/QC7swWy4/Here-Excel-forum-colors-ohne-rand.jpg[/img][/url]

[url=https://postimages.org/][img]https://i.postimg.cc/7PJxfpZ3/Here-Excel-fox-colors-ohne-rand.jpg[/img][/url]

now change link to post imagers to the link you want it to got to

https://i.postimg.cc/QC7swWy4/Here-E...-ohne-rand.jpg or https://i.postimg.cc/7PJxfpZ3/Here-E...-ohne-rand.jpg

Hello Chris, ( and Stuart )
In Excel things occasionally go out of whack in my VB Editor and I am buggered if I can ever find a way to get them back normally using any conventional method. Usually the docking of windows getting corrupted has been to blame.
So far the sledgehammer approach explained https://i.postimg.cc/QC7swWy4/Here-E...-ohne-rand.jpg has always put the VB Editor back to normal for me.
( In case that old post link does not work, or they insist on you logging in and you don’t want to, I just put a copy of that post https://i.postimg.cc/7PJxfpZ3/Here-E...-ohne-rand.jpg for you )

( you might need to look at a slightly different path in the registry. Someone else said they found it here: Computer\HKEY_CURRENT_USER\Software\Microsoft\VBA\ 7.1\Common

Alan

https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=15646&viewfull=1#post15646



https://i.postimg.cc/8k0mY0bK/Aufzeichnen.jpg

_.______________
Here

Here

ExcelFox


ExcelFox


Here


Here

Code:

---

https://www.excelforum.com/excel-programming-vba-macros/343845-docking-project-explorer-vertically.html#post4545938

---

https://i.postimg.cc/9Rf6XHnm/Here-link-Bild.jpg

https://i.postimg.cc/9Rf6XHnm/Here-link-Bild.jpg[/img]


_.____________________

_.______________
vorschor bild for forum
https://i.postimg.cc/9Rf6XHnm/Here-link-Bild.jpg

_.__________________________-
direct link for forum complete
https://i.postimg.cc/j56tXs67/Here-link-Bild.jpg or https://i.postimg.cc/WzngMQb7/Here-E...rum-colors.jpg 0r https://i.postimg.cc/Y2f6Kmfm/Here-Excel-fox-colors.jpg
Now change link to postimages.org to the link you want it to go to
https://i.postimg.cc/j56tXs67/Here-link-Bild.jpg or https://i.postimg.cc/WzngMQb7/Here-E...rum-colors.jpg or https://i.postimg.cc/Y2f6Kmfm/Here-Excel-fox-colors.jpg

https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21215&viewfull=1#post21215



https://i.postimg.cc/8k0mY0bK/Aufzeichnen.jpg

_.______________
Here

Here

ExcelFox


ExcelFox


Here


Here

Code:

---

https://www.excelforum.com/excel-programming-vba-macros/343845-docking-project-explorer-vertically.html#post4545938

---

https://i.postimg.cc/9Rf6XHnm/Here-link-Bild.jpg

https://i.postimg.cc/9Rf6XHnm/Here-link-Bild.jpg[/img]


_.____________________

_.______________
vorschor bild for forum
https://i.postimg.cc/9Rf6XHnm/Here-link-Bild.jpg

_.__________________________-
direct link for forum complete
https://i.postimg.cc/j56tXs67/Here-link-Bild.jpg or https://i.postimg.cc/WzngMQb7/Here-E...rum-colors.jpg 0r https://i.postimg.cc/Y2f6Kmfm/Here-Excel-fox-colors.jpg
Now change link to postimages.org to the link you want it to go to
https://i.postimg.cc/j56tXs67/Here-link-Bild.jpg or https://i.postimg.cc/WzngMQb7/Here-E...rum-colors.jpg or https://i.postimg.cc/Y2f6Kmfm/Here-Excel-fox-colors.jpg

https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21218&viewfull=1#post21218



https://www.youtube.com/watch?v=yVgLmj0aojI
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgwWg8x2WxLSxxGsUP14AaABAg. 9k3ShckGnhv9k89LsaigoO
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxxxIaK1pY8nNvx6JF4AaABAg. 9k-vfnj3ivI9k8B2r_uRa2
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxKFXBNd6Pwvcp4Bsd4AaABAg
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=Ugw9X6QS09LuZdZpBHJ4AaABAg

https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21217&viewfull=1#post21217

Code:

---

Sub FuckoffvbCrandvbLfinwordtext()  '  https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=18377&viewfull=1#post18377
Dim ClipTxt As String ': Let ClipTxt = " https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA " & vbCr & vbLf
Dim SelText As String
 Let SelText = Selection.Text

 Let ClipTxt = Replace(SelText, vbCr, "", 1, -1)
 Let ClipTxt = Replace(ClipTxt, vbLf, "", 1, -1)
'  Put the string in the clipboard
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '  web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
    .SetText ClipTxt
    .PutInClipboard
    End With
End Sub

---

Some string text in Word Tests and Experiments

Not doing anything special here, not yet anyway. I just want a quick coding to
_ take a highlighted text in a word .doc , and
_ pick out any URL links, and
_ put those links in the clipboard in some convenient form to paste somewhere.

What have we got
A good start point is to check what a typical text containing the URLs is, in particular we need to look in a bit more detail to see what non obvious, so called “invisible” characters may be there.

This is the coding to run after selecting some text in a word .doc

Code:

---

Option Explicit
'        https://www.excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=21221&viewfull=1#post21221      https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222&viewfull=1#post21222                                                                        String text in Word html.doc
Sub WhatsInIt()
Dim Str As String ' To hold the selected text in word
 Let Str = Selection.Text
Call WatchaGotWord(Str)
End Sub

---

The function can be found here https://www.excelfox.com/forum/showt...1221#post21221

---

Here is an example of some text
https://i.postimg.cc/hQddkG8q/A-bit-...-word-text.jpg

I indicated there, areas to be looked at.

Here is a few results of what the coding shows me

Code:

---

"Hub" & "." & vbCr & vbCr & "The " & "$"
"sUQxO5CVyx4AaABAg" & vbCr & vbCr & vbCr & "1 of " & "4"
"https" & ":" & "/" & "/" & "www" & "." & "youtube" & "." & "com" & "/" & "watch" & "?" & "v" & "=" & "yVgLmj0aojI" & "&" & "lc" & "=" & "UgwWg8x2WxLSxxGsUP14AaABAg" & "." & "9k3ShckGnhv9k89LsaigoO  1" & vbCr

---

Conclusions of text content investigation
No big surprises. It seems that a new line is indicated by vbCr – That is occaisionally used instead of the more typical 2 characters , vbCr & vbLf.

A solution for a quick coding would be:
_ Replace any vbCr ( or any pair of vbCr & vbLf just incase that is used anywhere ) , with a space.
_ Do a VBA Split using spaces as the separator.
_ Go through each array element, take any looking like a link.

_ Put those links in the clipboard in a convenient way to paste out



This will do for now

Code:

---

Sub URLsToClipboard()  '    https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222#post21222
Dim Str As String ' To hold the selected text in word
 Let Str = Selection.Text

 Let Str = Replace(Str, vbCr & vbLf, " ", 1, -1, vbBinaryCompare) ' Do this first before next line or else I might end up with  vbLfs  which may mess things up.  For now I assume the  vbLf  on its own wont be used anywhere. It rarely is
 Let Str = Replace(Str, vbCr, " ", 1, -1, vbBinaryCompare)
 
Dim SpltStr() As String
 Let SpltStr() = Split(Str, " ", -1, vbBinaryCompare)
 
'  Go through the array elements fromm the  Split  and build a string from any looking like  URLs  , I may as well join them in a string with a  vbCr & vbLf  as the joining but, since then i automatically have  the start of a convenient form to put in the clipboard, since likely I will want to paste the  URLs  in a list
Dim Cnt As Long
    For Cnt = LBound(SpltStr) To UBound(SpltStr)
    Dim StrClp As String ' The final string to put in clipboard
        If InStr(1, SpltStr(Cnt), "https://www", vbBinaryCompare) > 0 Then
        Let SpltStr(Cnt) = Trim(SpltStr(Cnt)) ' I think I probably don't need this, never mind
        Dim URL1 As String: Let URL1 = SpltStr(Cnt)
        Dim URL2 As String: Let URL2 = Replace(URL1, "tps://ww", "[color=white]tps://ww[/color]", 1, 1, vbBinaryCompare)  ' A version with  disguised  URL
       
        ' build the final forum post type string
        Dim FrmStr As String
        Let FrmStr = FrmStr & "[url=" & URL1 & "][color=white]" & URL2 & "[/color][/url]" & vbCr & vbLf
       
        Else
        ' element text is not a  URL
        End If
    Next Cnt
   
'  Put the string in the clipboard
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '  web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
    .SetText FrmStr
    .PutInClipboard
    End With
End Sub

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=ySENWFIkL7c
https://www.youtube.com/watch?v=ySENWFIkL7c&lc=UgyqIYcMnsUQxO5CVyx4AaABAg
https://www.youtube.com/watch?v=yVgLmj0aojI
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgwWg8x2WxLSxxGsUP14AaABAg. 9k3ShckGnhv9k89LsaigoO
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxxxIaK1pY8nNvx6JF4AaABAg. 9k-vfnj3ivI9k8B2r_uRa2
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxKFXBNd6Pwvcp4Bsd4AaABAg
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=Ugw9X6QS09LuZdZpBHJ4AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA


Then I did this one, because like a twat I forgot where I put the last one

Code:

---

Sub WhiteSpamUrl()              '    https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222&viewfull=1#post21222
Dim ClipTxt As String: Let ClipTxt = "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]" & vbCr & vbLf
Dim SelText As String
 Let SelText = Selection.Text
Dim RwTxt() As String
 Let RwTxt() = Split(SelText, vbCr, -1, vbBinaryCompare)
Dim RwCnt As Long
    For RwCnt = LBound(RwTxt()) To UBound(RwTxt())
    Dim ClmTxt() As String
    Let ClmTxt() = Split(RwTxt(RwCnt), " ", -1, vbBinaryCompare)
    Dim ClmCnt As Long
        For ClmCnt = LBound(ClmTxt()) To UBound(ClmTxt())
            If InStr(1, Trim(ClmTxt(ClmCnt)), "//www.", vbBinaryCompare) > 0 Then
            Dim URL As String, URL2 As String
            Let URL = Trim(ClmTxt(ClmCnt))
            Let URL2 = Replace(URL, "http", "ht[color=white]tp[/color]", 1, 1, vbBinaryCompare)
            Let URL2 = Replace(URL2, "//www.", "/[color=white]/ww[/color]w.", 1, 1, vbBinaryCompare)
            Let ClipTxt = ClipTxt & "[url=" & URL & "] [color=white] " & URL2 & " [/color] [/url]" & vbCr & vbLf
            Else
            ' no url
            End If
       
        Next ClmCnt
    Next RwCnt
 Let ClipTxt = ClipTxt & "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]"

'  Put the string in the clipboard
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '  web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
    .SetText ClipTxt
    .PutInClipboard
    End With
End Sub

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=vXyMScSbhk4
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgynOSp1dleo-Z8L_QN4AaABAg.9jJLDC1Z6L-9k68CuL4aTY
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgwV5N_ulFXYMNbyQG54AaABAg. 9itCkoVN4w79itOVYVvEwQ
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgyOh-eR43LvlIJLG5p4AaABAg.9isnKJoRfbL9itPC-4uckb
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugy1B1aQnHq2WbbucmR4AaABAg. 9isY3Ezhx4j9itQLuif26T
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgxxajSt03TX1wxh3IJ4AaABAg. 9irSL7x4Moh9itTRqL7dQh
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugxa2VYHMWJWXA6QI294AaABAg. 9irLgSdeU3r9itU7zdnWHw
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgwJAAPbp8dhkW2X1Uh4AaABAg. 9iraombnLDb9itV80HDpXc
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgzIzQ6MQ5kTpuLbIuB4AaABAg. 9is0FSoF2Wi9itWKEvGSSq
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

Code:

---


Sub WhiteSpamUrl()  '  White Spam URL  WhiteSpamUrl WhiteSpamUrl()  [url]https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222&viewfull=1#post21222[/url]    [url]https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=18376&viewfull=1#post18376[/url]
Dim ClipTxt As String: Let ClipTxt = "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]" & vbCr & vbLf
Dim SelText As String
 Let SelText = Selection.Text
Dim RwTxt() As String
 Let RwTxt() = Split(SelText, vbCr, -1, vbBinaryCompare)
Dim RwCnt As Long
    For RwCnt = LBound(RwTxt()) To UBound(RwTxt())
    Dim ClmTxt() As String
    Let ClmTxt() = Split(RwTxt(RwCnt), " ", -1, vbBinaryCompare)
    Dim ClmCnt As Long
        For ClmCnt = LBound(ClmTxt()) To UBound(ClmTxt())
            If InStr(1, Trim(ClmTxt(ClmCnt)), "//www.", vbBinaryCompare) > 0 Or InStr(1, Trim(ClmTxt(ClmCnt)), "https://", vbBinaryCompare) > 0 Or InStr(1, Trim(ClmTxt(ClmCnt)), "http://", vbBinaryCompare) > 0 Then
            Dim URL As String, URL2 As String
            Let URL = Trim(ClmTxt(ClmCnt))
            Let URL2 = Replace(URL, "http", "ht[color=white]tp[/color]", 1, 1, vbBinaryCompare)
            Let URL2 = Replace(URL2, "//www.", "/[color=white]/ww[/color]w.", 1, 1, vbBinaryCompare)
            Let ClipTxt = ClipTxt & "[url=" & URL & "] [color=white] " & URL2 & " [/color] [/url]" & vbCr & vbLf
            Else
            ' no url
            End If
       
        Next ClmCnt
    Next RwCnt
 Let ClipTxt = ClipTxt & "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]"
' Check string length
Dim LenClipTxt As Long: Let LenClipTxt = Len(ClipTxt)
MsgBox Prompt:=LenClipTxt
'  Put the string in the clipboard
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '  web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
    .SetText ClipTxt
    .PutInClipboard
    End With
End Sub

---