Appendix Thread. ( Codes for other Threads, ( Avinash ).)

[DocAElstein]

Re: Appendix Thread. ( Codes for other Threads, HTML Tables, etc. )

Hi
. I would like to use this Thread as an Appendix for codes in other Threads so as to help reduce clutter in that Thread should the code be a bit long, or not directly relevant.
. Also as HTML code is on in this Test Sub Forum I would like to reference HTML Tables should I wish to use them in answering threads

@ Moderators, Administrator:
. I hope the above is OK to do and if so please do not delete this Thread. ( Or advise if I should post my "Appendix" somewhere else ( If possible where HTML code is on ) )
.
. Many Thanks
Alan


Edit July 2020 This thread is copy of Avinash's macros in Test Area
https://excelfox.com/forum/showthrea...L-Tables-etc-)
2577



https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA



https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=tzbKqTRuRzU&lc=UgyYW2WZ2DvSrzUKnJ14AaABAg
https://www.youtube.com/watch?v=UywjKEMjSp0&lc=UgxIySxHPqM1RxtVqoR4AaABAg.9edGvmwOLq99eekDyfS0 CD
https://www.youtube.com/watch?v=UywjKEMjSp0&lc=UgxIySxHPqM1RxtVqoR4AaABAg.9edGvmwOLq99eevG7txd 2c
https://www.youtube.com/watch?v=SIDLFRkUEIo&lc=UgzTF5vvB67Zbfs9qvx4AaABAg
https://www.youtube.com/watch?v=9P6r7DLS77Q&lc=UgzytUUVRyw9U55-6M54AaABAg
https://www.youtube.com/watch?v=9P6r7DLS77Q&lc=UgzCoa6tOVIBxRDDDbN4AaABAg
https://www.youtube.com/watch?v=9P6r7DLS77Q&lc=UgyriWOelbVnw4FHWT54AaABAg.9dPo-OdLmZ09dc21kigjmr
https://www.youtube.com/watch?v=363wd2EtQZ0&lc=UgzDQfo5rJqyVwvv2r54AaABAg
https://www.youtube.com/watch?v=363wd2EtQZ0&lc=UgzHTSka7YppBdmUooV4AaABAg.9cXui6zzkz09cZttH_-2Gf
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

[DocAElstein]

Function FuR_Alan(ByVal rngIn As Range, ByVal FoutRw As Long) As Variant
10  ' use "neat magic" code line    arrOut() = Application.Index(arrIn(), rwsT(), clms())  '                 http://www.excelforum.com/excel-new-...ba-arrays.html                      http://www.mrexcel.com/forum/excel-q...ml#post4375354
20  ' BUT in Cells form             arrOut() = Application.Index(Cells, rwsT(), clms())    '                      http://www.excelforum.com/excel-prog...t-range-2.html
30  Dim ws As Worksheet '                                      ' Preparing a "Pointer" to an Initial "Blue Print" ( or a Form, or a Questionnaire not yet filled in, a template   etc.) in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Object of this type ) . This also us to get easily at the Methods and Properties through the applying of a period ( .Dot) ( intellisense )
40  Set ws = rngIn.Parent                                      ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-prog...ml#post4387191
50                                ws.Range("K30").ClearContents: ws.Range("K30").Value = "Here I am, in this Worksheet!"
60  'clms()
70  Dim sClm As Long, Cs As Long 'Variable for Count of, Start Column. - This makes a Pigeon Hole sufficient in construction to house a piece of Paper with code text giving the relevant information for the particular Variable Type. VBA is sent to it when it passes it. In a Routine it may be given a particular “Value”, or (“Values” for Objects).  There instructions say then how to do that and handle(store) that(those). At Dim the created Paper is like a Blue Print that has some empty spaces not yet filled in. Long is very simple to handle, final memory "size" type is known (13.456, 00.001 have same "size" computer memory ),so an Address suggestion can be given for when the variable is filled in. (Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647). If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.-upon/after 32-bit, Integers (Short) need converted internally anyway, so a Long is actually faster)
80  Let sClm = rngIn.Areas.Item(1).Column: Cs = rngIn.Areas.Item(1).Columns.Count '                    A Range in a Worksheet must not be continuous.  The way I understand it, a Range object is a group of cells in a worksheet.  The list of the cells of the range is organised in rectangular groups of cells, each one named an Area.  Post #27  http://www.mrexcel.com/forum/excel-q...-column-3.html       http://www.eileenslounge.com/viewtop...181736#p181736
90  Dim clms() As Variant '           Evaluate Function used below returns a Field of Variant Element Types so the Array Elemments must be Declared appropriately. Must be adynamic Array to accept and be effectivelly sized by the Field size assigned to it.
95  Let clms() = Evaluate("column(" & CL(sClm) & ":" & CL(sClm + (Cs - 1)) & ")")
100
160 'rwsT()
170 Dim sRw As Long, Rs As Long '
180 Let sRw = rngIn.Areas.Item(1).Row: Let Rs = rngIn.Areas.Item(1).Rows.Count
240 'Get Full row indicies convenientally ( As 1 D "pseudo horizontal" Array ) from Spreadsheet Column() Function
250 Dim rws() As Variant: Let rws() = Evaluate("column(" & CL(sRw) & ":" & CL(sRw + (Rs - 1)) & ")")
260
280 'Get full sequential row indicies in a string.
290 Dim strRws As String: Let strRws = VBA.Strings$.Join(rws(), "|") '            'The VBA strings collection such as Join in there basic form must not returnn a string, they can also return for example Null, a special type of variant. That lies within it's "powers. - It will coerce even an Empty, or Null to a variant type and return that. That takes extra ( unecerssary work here ). If the result of a function is used as a string or assigned it to a string variable, use the $ form of the function. This results in faster executing code, because a conversion from a variant to a string is unnecessary.      http://www.excelforum.com/excel-new-...ml#post4084783      I believe that without $ a Strings collection Function coerces the first parameter into  Variant, with $ does not - that's why $ is preferable over no $ , it's theoretically more efficient.        http://www.xoc.net/standards/rvbacc....rSignFunctions
300
330 'Get String with missing row
340 Dim strrwsD As String: Let strrwsD = Replace(strRws, "|" & FoutRw & "", "", 1, -1)
350
360 'Get Array ( 1 D Pseudo Horizontal ) of required row indicies
370 Dim rwsS() As String '              The VBA Strings Collection Function, Split, used below returns a Field of String Element Types so the Array Elemments must be Declared appropriately. It must be adynamic Array to accept and be effectivelly sized by the Field size assigned to it.
375 Let rwsS() = VBA.Strings$.Split(strrwsD, "|", -1)
380 'final Transposed Array for "magic neat" code line
390 Dim rwsT() As String: ReDim rwsT(0 To (UBound(rwsS())), 1 To 1) '          Both the type and size of Array is known so can be decared initially appropriatelly. Re Dim must be used as Dim only takes values, not variables
400 Dim Cnt As Long
410     For Cnt = 0 To UBound(rwsS())
420      Let rwsT(Cnt, 1) = rwsS(Cnt)
430     Next Cnt

440 'Output Array
450 Dim arrOut() As Variant
460 Let arrOut() = Application.Index(ws.Cells, rwsT(), clms()) '"Magic neat" Code line in Cells first argument Form
470
480 Let FuR_Alan = arrOut()
490
500 ' . Transpose
510 Dim rwsDotT() As Variant '         Transpose Function used below returns a Field of Variant Element Types so the Array Elemments must be Declared appropriately. Must be adynamic Array to accept and be effectivelly sized by the Field size assigned to it.
520 Let rwsDotT() = Application.Transpose(rwsS())
530 Let arrOut() = Application.Index(ws.Cells, rwsDotT(), clms())
540
550 Let FuR_Alan = arrOut()
'
End Function

Function Code for getting Column Letter from Column Number is in main Thread

http://www.excelfox.com/forum/showth...=9837#post9837
Public Function CL(ByVal lclm As Long) As String
and Further given again along with an 'opened up' and 'Commented version in next post

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

[DocAElstein]

Function Code for getting Column Letter from Column Number
Shortened version used in Post #14
http://www.excelfox.com/forum/showth...=9837#post9837
Public Function CL(ByVal lclm As Long) As String

And Fuller version with explaining ‘Comments

Public Function CL(ByVal lclm As Long) As String '         http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
    Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function

Function FukOutChrWithDoWhile(ByVal lclm As Long) As String 'Using chr function and Do while loop      For example http://www.excelforum.com/excel-programming-vba-macros/796472-how-to-go-from-column-number-to-column-letter.html
Dim rest As Long 'Variable for what is "left over" after subtracting as many full 26's as possible
    Do
    '    Let rest = ((lclm - 1) Mod 26) 'Gives 0 to 25 for Column Number "Left over" 1 to 26. Better than ( lclm Mod 26 ) which gives 1 to 25 for clm 1 to 25 then 0 for 26
    '    Let FukOutChrWithDoWhile = Chr(65 + rest) & FukOutChrWithDoWhile 'Convert rest to Chr Number, initially with full number so the "units" (0-25), then number of 26's left over (if the number was so big to give any amount of 26's in it, then number of 26's in the 26's left over (if the number was so big to give any amount of 26 x 26's in it, Enit ?
    '    'OR
    Let FukOutChrWithDoWhile = Chr(65 + (((lclm - 1) Mod 26))) & FukOutChrWithDoWhile
    Let lclm = (lclm - (1)) \ 26 'This gives the number of 26's ( if any ), but just the excact part, in the next number down , - so applying the rest formula to this new number will again leave a difference "left over" rest.
    'lclm = (lclm - (rest + 1)) \ 26 ' As the number is effectively truncated here, any number from 1 to (rest +1)  will do in the formula
    Loop While lclm > 0 'Only loop further if number was big enough to still have 0-25's in it
End Function
Rem Ref    http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
Rem Ref    http://www.excelforum.com/tips-and-tutorials/1108643-vba-column-letter-from-column-number-explained.html

[DocAElstein]

Referrences in suppost of this post:
http://www.excelfox.com/forum/showth...=9985#post9985

and solution to this post
http://www.excelforum.com/excel-prog...ml#post4507157



' http://www.snb-vba.eu/VBA_Arraylist_en.html
' http://www.snb-vba.eu/VBA_Arraylist_en.html#L_11.3


' https://usefulgyaan.wordpress.com/20...1/#comment-587

' https://usefulgyaan.wordpress.com/20...1/#comment-515

'   https://usefulgyaan.wordpress.com/2013/06/12/vba-trick-of-the-week-slicing-an-array-without-loop-application-index/comment-page-1/#comment-587
Sub M_snbSortof()  '   http://www.snb-vba.eu/VBA_Arraylist_en.html#L_11.3
Dim rngVoll As Range: Set rngVoll = Tabelle3.Range("A1:E10")
Dim snAll() As Variant, Sported() As Variant
 Let snAll() = rngVoll.Value
Dim j As Long, jj As Long
    With CreateObject("System.Collections.Arraylist")
        For j = 1 To UBound(snAll(), 1)
         .Add snAll(j, 3)
        Next
     .Sort
     Let Sported() = .ToArray
     .Clear
        For j = 0 To UBound(Sported())
            For jj = 1 To UBound(snAll(), 1)
                If snAll(jj, 3) = Sported(j) Then
                ' Use Range to overcome  Array size Limits of Worksheets Functions
                'Dim Clm As Range: Set Clm = Application.Index(rngVoll, jj, 0)
                ' .Add Clm.Value
                ' .Add (Application.Index(rngVoll, jj, 0).Value)
                
                ' Use Cells to overcome  Array size Limits of Worksheets Functions
                Dim LB As Long, UB As Long '…User Given start and Stop Column as a Number
                 Let LB = LBound(snAll(), 2): Let UB = UBound(snAll(), 2)
                Dim strLtrLB As String, strLtrUB As String '…Column Letter corresponding to Column Number
                'There are many ways to get a Column Letter from a Column Number – excelforum.com/tips-and-tutorials/1108643-vba-column-letter-from-column-number-explained.html
                 Let strLtrLB = Split(Cells(1, LB).Address, "$")(1) 'An Address Method
                 Let strLtrUB = Replace (Replace(Cells(1, UB).Address, "1", ""), "$", "") 'A Replace Method
                'Obtain Column Indicies using Spreadsheet Function Column via VBA Evaluate Method
                Dim clms() As Variant
                 Let clms() = Evaluate("column(" & strLtrLB & ":" & strLtrUB & ")") 'Returns 1 D “pseudo” Horizontal Array of sequential numbers from column number of LB to UB
                'Or
                 clms() = Evaluate("column(" & Split(Cells(1, LB).Address, "$")(1) & ":" & Replace (Replace(Cells(1, UB).Address, "1", ""), "$", "") & ")")
                .Add (Application.Index(Tabelle3.Cells, jj, clms()))
                 
                 'Let snAll(jj, 3) = ""
                Exit For
                End If
            Next jj
        Next j
        For j = 0 To .Count - 1
         Tabelle3.Cells(j + 1 + 10, 1).Resize(, UBound(snAll, 2)) = .Item(j)
        Next j
    End With
End Sub
'
Sub M_snb()
Dim sn, sp, j As Long, jj As Long
sn = Tabelle3.Range("A1:E10")
    With CreateObject("System.Collections.Arraylist")
        For j = 1 To UBound(sn)
        .Add sn(j, 3)
        Next
     .Sort
     sp = .ToArray
     .Clear
        For j = 0 To UBound(sp)
            For jj = 1 To UBound(sn)
                If sn(jj, 3) = sp(j) Then
                 .Add Application.Index(sn, jj)
                 sn(jj, 3) = ""
                Exit For
                End If
            Next
        Next
        For j = 0 To .Count - 1
         Tabelle3.Cells((j + 1) + 10, 1).Resize(, UBound(sn, 2)) = .Item(j)
        Next
    End With
End Sub































'Rem Ref
'    http://www.excelforum.com/excel-programming-vba-macros/1139207-how-to-move-a-userform-and-module-from-one-book-to-another-2.html
'    http://www.excelforum.com/excel-programming-vba-macros/1138300-vba-userform-value-check-if-user-form-buttons-checked-not-working-check-button-on-open.html
'    http://www.excelforum.com/excel-programming-vba-macros/1139742-workbooks_open-crashes-when-file-opened-with-code-manually-open-ok-userform-issue.html
'    http://www.excelfox.com/forum/showthread.php/2130-Sort-an-array-based-on-another-array-VBA?p=9985#post9985
'    http://www.snb-vba.eu/VBA_Arraylist_en.html
'    http://www.snb-vba.eu/VBA_Arraylist_en.html#L_11.3
'    http://www.excelforum.com/showthread.php?t=1154829&page=4#post4502593
'    http://www.excelforum.com/excel-programming-vba-macros/1160648-how-to-create-a-pop-up-notification-for-two-different-conditions-at-the-same-time.html#post4507157
'    http://www.excelfox.com/forum/showthread.php/2130-Sort-an-array-based-on-another-array-VBA?p=9985#post9985

http://www.excelforum.com/showthread...=4#post4502593

[DocAElstein]

Function codes discussed in this Post:
http://www.excelfox.com/forum/showth...0527#post10527

Public Function MyLengthyStreaming() As String
Rem 1 Make a long string from a Microsoft Word doc
'1(i) makes available the Library of stuff, objects, Methods etc.
Dim Fso As Object: Set Fso = CreateObject("Scripting.FileSystemObject")
'1(ii) makes the big File Object                       " Full path and file name of Word doc saved as .htm       "
Dim FileObject As Object: Set FileObject = Fso.GetFile("G:\ALERMK2014Marz2016\NeueBlancoAb27.01.2014\AbJan2016\ProMessageTelekom.htm"): Debug.Print FileObject
'1(iii) sets up the data  "stream highway"
Dim Textreme As Object:  Set Textreme = FileObject.OpenAsTextStream(iomode:=1, Format:=-2)        '   reading only, Opens using system default            https://msdn.microsoft.com/en-us/library/aa265341(v=vs.60).aspx
'1(iv) pulls in the data, in our case into a simple string variable
 Let MyLengthyStreaming = Textreme.ReadAll         '        Let MyLengthyStreaming = Replace(MyLengthyStreaming, "align=center x:publishsource=", "align=left x:publishsource=")
 Textreme.Close
 Set Textreme = Nothing
 Set Fso = Nothing
 Let MyLengthyStreaming = MyLenghtyDiesScreaming_Telekom(MyLengthyStreaming) ' After this code line is done we have the string modified so that it gives the correct results in German Telekom Freemail t-online.de
Rem 2 possible additions to MyLengthyStreaming
' 
'
'
'
End Function
'
'  The second function below is mainly intended to make a modification to get the correct results in German Telekom Freemail t-online.de , but also the large html text not required from the start and a small amount at the end is also removed. (It does not need to be removed as it appears that it is ignored)
Public Function MyLenghtyDiesScreaming_Telekom(ByVal MyLengfyScream As String) As String '  Effectively this Dim's  MyLenghtyDiesScreaming_Telekom  as a String variable and  MyLenghtyDiesScreaming_Telekom  can be used as such in this function code.  Assigning a variable to this in a main code will cause  the value held by VBA in the variable  MyLenghtyDiesScreaming_Telekom   at that point to be out in the assigned variable, but fist the main code will be paused at  this "calling"  code line whilst the Function code is carried out.  So we have the chance to do something in the function to fill that variable, MyLenghtyDiesScreaming_Telekom . We can take one or more things in in the ( ) to use . In this case we want to take a string in and then return it modified , hence the last code line is simply   MyLenghtyDiesScreaming_Telekom = MyLengfyScream
Dim CntPus As Long '      A number constant for the positions of characters used in a couple of places.        Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in.  '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. )       https://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html
' Take off all the first lot on unecessary required HTML
 Let CntPus = InStr(1, MyLengfyScream, "<div class=WordSection1>", vbTextCompare) '  return the position (starting from the fist character ,  Looking in the string  ,  for that text  ,  doing a text comparison which is case insensitive  )
 Let MyLengfyScream = Mid(MyLengfyScream, CntPus + 26)
' Add to this array below all possible fonts in quotes      I have to use Variant type as the VBA Array( ) Method used below pruduces a 1 dimmansional Array of Variant types.   I may assing a dynamic Array of variant types to what the VBA Array( ) Function returns
Dim arsFonts() As Variant: Let arsFonts() = Array("""Andale Mono""", """Times""", """serif""", """Arial""", """sans-serif""", """Arial Black""", """Comic Sans MS""", """Courier New""", """Georgia""", """Helvetics""", """Impact""", """Tahoma""", """Terminal""", """monaco""", """Times New Roman""", """Trebuchet MS""", """Verdana""", """Arial Narrow""", """Batang""", """Calibri""", """Cambri Math""", """FangSong""", """Gungsuh""", """GungsuhChe""", """Franklin Gothic Heavy""")
Dim arschFont As Variant ' It is a required syntax that the stearing element in the For Each loop to be Variant type or Object type, ( the object type can be  Object   or ther specific object. if I do not specify specifically then VBVA defaults to all simialr ngs in the thing you are going through                                                                        '  http://www.excelfox.com/forum/showthread.php/2157-Re-Defining-multiple-variables-in-VBA?p=10192#post10192
' Look for things like "Font"  and replace the " with an arbitrary string like ScrotumSack , so  "Font"  becomes  ScrotumSackFontScrotumSack
    For Each arschFont In arsFonts() ' Loop to look for and replce each Font held in "s with the same font but in 's
     If InStr(1, MyLengfyScream, arschFont, vbTextCompare) > 1 Then ' case a Font in quotes , like "font"  ,  so for that font in quotes... and ...
     Dim FontSingleScrQuote As String: Let FontSingleScrQuote = Replace(arschFont, """", "ScrotumSack", 1, 2, vbBinaryCompare) ' ...Make a that font in ScrotumSack  like ScrotumSackfontScrotumSack ... and ...     I use ScrotumSack arbitrarily as I find it funny and I doubt anyone else does.. does use it, so I won't have that already in the text. I cannot go straight to using the '  because if I do that now then I won't be able to distinguisch the existing ' which I want to change to "  in the next bit
      Let MyLengfyScream = Replace(MyLengfyScream, arschFont, FontSingleScrQuote, 1, -1, vbTextCompare) ' .... replace all "fonts" with ScrotumSackfontsScrotumSack
     Else '  no arsch Font in My lengfy scream
     End If
    Next arschFont
' replace any ' with "  This is mainly intended to replace enclosed in ' strings like   askjhhsa ='kasjhScrotumSackfontScrotumSackfcb qwq 63 = Bollocks' jdgsjag   with     askjhhsa ="kasjhScrotumSackfontScrotumSackfcb qwq 63 = Bollocks" jdgsjag
 Let MyLengfyScream = Replace(MyLengfyScream, "'", """", 1, -1, vbTextCompare)
' Scratch my Scrotum sacks, - that is to say replace them with a with  '   I can do this now since the existing  '  have been changeed to "  so the ScrotumSacks , which were originally "s , can now be chnged to 's
 Let MyLengfyScream = Replace(MyLengfyScream, "ScrotumSack", "'", 1, -1, vbTextCompare)
' take last unecessary bit of HTML off
 Let CntPus = InStrRev(MyLengfyScream, "</div>", -1, vbTextCompare) ' get the position counting from the left but looking from the right   ( in MyLengfyScream , of </div> , start looking from end , make text comparison which is case insensitive )
 Let MyLengfyScream = Left(MyLengfyScream, CntPus - 1)
' Finally we set here what is actually returned by virtue of effectively putting something in the pseudo variable  MyLenghtyDiesScreaming_Telekom
 Let MyLenghtyDiesScreaming_Telekom = MyLengfyScream
End Function

[DocAElstein]

Some sample data for other Posts and Threads:
http://www.excelfox.com/forum/showth...ing-Techniques

Using this code: _..

 Sub Its() ' snb 2017
Dim It As Variant
  For Each It In ThisWorkbook.VBProject.References
  Dim strIts As String
   Let strIts = strIts & "Description:" & vbTab & It.Description & vbCr & "Name:" & vbTab & vbTab & It.Name & vbCr & "Buitin:" & vbTab & vbTab & It.BuiltIn & vbCr & "Minor:" & vbTab & vbTab & It.minor & vbCr & "Major:" & vbTab & vbTab & It.major & vbCr & "FullPath:" & vbTab & vbTab & It.fullpath & vbCr & "GUID:" & vbTab & vbTab & It.GUID & vbCr & "Type:" & vbTab & vbTab & It.Type & vbCr & "Isbroken:" & vbTab & vbTab & It.isbroken & vbCr & vbCr
  Next It
Debug.Print strIts ' From  VB Editor Ctrl+g  to get Immediate Window from which info can be copied
End Sub

_.. you can get text displayed in the Immediate Window which you can copy.




Some example VBA available checked Libraries:
VBACheckedAvailableLibraries_1.JPG : https://imgur.com/scnHhHR
Attachment 1992
Here below the code output based on running in a Workbook which has the libraries checked as in the above screenshot:

Description:    Visual Basic For Applications
Name:       VBA
Buitin:     Wahr
Minor:      0
Major:      4
FullPath:       C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
GUID:       {000204EF-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Description:    Microsoft Excel 12.0 Object Library
Name:       Excel
Buitin:     Wahr
Minor:      6
Major:      1
FullPath:       C:\Program Files\Microsoft Office\Office12\EXCEL.EXE
GUID:       {00020813-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Description:    OLE Automation
Name:       stdole
Buitin:     Falsch
Minor:      0
Major:      2
FullPath:       C:\Windows\system32\stdole2.tlb
GUID:       {00020430-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Description:    Microsoft Office 12.0 Object Library
Name:       Office
Buitin:     Falsch
Minor:      4
Major:      2
FullPath:       C:\Program Files\Common Files\Microsoft Shared\OFFICE12\MSO.DLL
GUID:       {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}
Type:       0
Isbroken:       Falsch

Description:    Microsoft HTML Object Library
Name:       MSHTML
Buitin:     Falsch
Minor:      0
Major:      4
FullPath:       C:\Windows\system32\mshtml.tlb
GUID:       {3050F1C5-98B5-11CF-BB82-00AA00BDCE0B}
Type:       0
Isbroken:       Falsch

Description:    Microsoft XML, v6.0
Name:       MSXML2
Buitin:     Falsch
Minor:      0
Major:      6
FullPath:       C:\Windows\System32\msxml6.dll
GUID:       {F5078F18-C551-11D3-89B9-0000F81FE221}
Type:       0
Isbroken:       Falsch

Description:    Microsoft Forms 2.0 Object Library
Name:       MSForms
Buitin:     Falsch
Minor:      0
Major:      2
FullPath:       C:\Windows\system32\FM20.DLL
GUID:       {0D452EE1-E08F-101A-852E-02608C4D0BB4}
Type:       0
Isbroken:       Falsch

This infomation above can be useful for Later Early Binding.

_.__________________

Note that for Broken Libraries the GUID infomation appears to be available also, so I would tend to use .AddFromguid for Later Early Binding simply as I may heve a better chance of collecting before hand the GUID infomation than I do for other properties:
MidTestJeffMoseToolsBroke.JPG : https://imgur.com/ZKq8BTr
Attachment 1993

MostPropertiesOfbrokenreferencesDontWork.JPG : https://imgur.com/FcVjDLl
Attachment 1994
In this example , the last two Library references were broken, but the GUID infomation is still available

[DocAElstein]

Some sample data for other Posts and Threads:
http://www.eileenslounge.com/viewtopic.php?f=30&t=29652
Using this code:

 Sub Its() ' snb 2017
Dim It As Variant
  For Each It In ThisWorkbook.VBProject.References
  Dim strIts As String
   Let strIts = strIts & "Description:" & vbTab & It.Description & vbCr & "Name:" & vbTab & vbTab & It.Name & vbCr & "Buitin:" & vbTab & vbTab & It.BuiltIn & vbCr & "Minor:" & vbTab & vbTab & It.minor & vbCr & "Major:" & vbTab & vbTab & It.major & vbCr & "FullPath:" & vbTab & vbTab & It.fullpath & vbCr & "GUID:" & vbTab & vbTab & It.GUID & vbCr & "Type:" & vbTab & vbTab & It.Type & vbCr & "Isbroken:" & vbTab & vbTab & It.isbroken & vbCr & vbCr
  Next It
Debug.Print strIts ' From  VB Editor Ctrl+g  to get Immediate Window from which info can be copied
End Sub

Here some results. ( If anyone passing has other Excel versions and would like to pass on what the code above gives, then that would be nice, thanks )

Excel 2007

Description:    Visual Basic For Applications
Name:       VBA
Buitin:     Wahr
Minor:      0
Major:      4
FullPath:       C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
GUID:       {000204EF-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Description:    Microsoft Excel 12.0 Object Library
Name:       Excel
Buitin:     Wahr
Minor:      6
Major:      1
FullPath:       C:\Program Files\Microsoft Office\Office12\EXCEL.EXE
GUID:       {00020813-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Description:    OLE Automation
Name:       stdole
Buitin:     Falsch
Minor:      0
Major:      2
FullPath:       C:\Windows\system32\stdole2.tlb
GUID:       {00020430-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Description:    Microsoft Office 12.0 Object Library
Name:       Office
Buitin:     Falsch
Minor:      4
Major:      2
FullPath:       C:\Program Files\Common Files\Microsoft Shared\OFFICE12\MSO.DLL
GUID:       {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}
Type:       0
Isbroken:       Falsch

Description:    Microsoft Word 12.0 Object Library
Name:       Word
Buitin:     Falsch
Minor:      4
Major:      8
FullPath:       C:\Program Files\Microsoft Office\Office12\MSWORD.OLB
GUID:       {00020905-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Excel 2003

Description:    Visual Basic For Applications
Name:       VBA
Buitin:     Wahr
Minor:      0
Major:      4
FullPath:       C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
GUID:       {000204EF-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Description:    Microsoft Excel 11.0 Object Library
Name:       Excel
Buitin:     Wahr
Minor:      5
Major:      1
FullPath:       C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
GUID:       {00020813-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Description:    OLE Automation
Name:       stdole
Buitin:     Falsch
Minor:      0
Major:      2
FullPath:       C:\Windows\system32\stdole2.tlb
GUID:       {00020430-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Description:    Microsoft Office 11.0 Object Library
Name:       Office
Buitin:     Falsch
Minor:      3
Major:      2
FullPath:       C:\Program Files\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
GUID:       {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}
Type:       0
Isbroken:       Falsch

Description:    Microsoft Word 12.0 Object Library
Name:       Word
Buitin:     Falsch
Minor:      4
Major:      8
FullPath:       C:\Program Files\Microsoft Office\Office12\MSWORD.OLB
GUID:       {00020905-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

Excel 2010

Description:    Visual Basic For Applications
Name:       VBA
Buitin:     Wahr
Minor:      1
Major:      4
FullPath:       C:\PROGRA~2\COMMON~1\MICROS~1\VBA\VBA7\VBE7.DLL
GUID:       {000204EF-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch
 
Description:    Microsoft Excel 14.0 Object Library
Name:       Excel
Buitin:     Wahr
Minor:      7
Major:      1
FullPath:       C:\Program Files (x86)\Microsoft Office\Office14\EXCEL.EXE
GUID:       {00020813-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch
 
Description:    OLE Automation
Name:       stdole
Buitin:     Falsch
Minor:      0
Major:      2
FullPath:       C:\Windows\SysWOW64\stdole2.tlb
GUID:       {00020430-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch
 
Description:    Microsoft Office 14.0 Object Library
Name:       Office
Buitin:     Falsch
Minor:      5
Major:      2
FullPath:       C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE14\MSO.DLL
GUID:       {2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}
Type:       0
Isbroken:       Falsch
 
Description:    Microsoft Word 14.0 Object Library
Name:       Word
Buitin:     Falsch
Minor:      5
Major:      8
FullPath:       C:\Program Files (x86)\Microsoft Office\Office14\MSWORD.OLB
GUID:       {00020905-0000-0000-C000-000000000046}
Type:       0
Isbroken:       Falsch

[DocAElstein]

_1) You may need to “Go Advanced”
The normal Start point is with the Paper Clip icon at the top of the Editor Window.
( That icon will be present in the initial Post Editor, but it may not always be available for further Replys. You may need first to “Go Advanced” GoAdvancedReplyWindow.JPG : GoAdvanced1.JPG https://imgur.com/1A9qWQM : https://imgur.com/UXBZ4oJ , then scroll down to Manage Attachments** , then jump to step _3)

_2) _3) Hit Paper Clip and _3 ) Add Files
PaperClip2AddFiles3.JPG
https://imgur.com/vbPQvTr

_4) Select Files
SelectFiles.JPG
https://imgur.com/aqtVTPa

_5) Upload Files
UploadFiles5.JPG
https://imgur.com/pUfmZc7

_6) Hit Done
Done6.JPG
https://imgur.com/kQAwzao

_-.----
Manage Attachments**
You can also get thereabouts with the Manage Attachments option which you will see when you scroll down after hitting “Go Advanced”
ManageAttachments.JPG
https://imgur.com/KxTxRoC

_.------
To delete Files:
DeleteAttachment.JPG
https://imgur.com/STzpq9E

_..
The eteps may vary a bit depending on from where and when you start, and depending on your browser., so …
Best is to practice posting here:
http://www.excelfox.com/forum/forumd...p/17-Test-Area
Start a new Thread, with a title such as “Just testing and practicing posting, no reply needed”
You can do anything you want, post anything, Edit, and try again etc… etc..

[DocAElstein]

To support these Threads
https://excelfox.com/forum/showthrea...4560#post14560
http://www.excelfox.com/forum/showth...0679#post10679

Re post code in Code tags, Like ....

Please use CODE TAGS if you are writing codes in your post.

To use code tags,
either
select your entire code and press the code tag button # in the editor below,
or
simply type your code as below

[Code]Your Code Here[/Code]

[Code]
Your Code Here
[/Code]




[Code]
Private Sub cmdNot_Click()

Dim OutApp As Object
Dim OutMail As Object

…………………….

……………..

End Sub
[/Code]




BBCodeCodeTags.JPG : https://imgur.com/4HunNcs
Attachment 2060

_.__________________

If you post using Code tags, then it will come out in the final post in a Code Window, like this:

Private Sub cmdNot_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim fileName As String
Dim mSubject As String
Dim signature As String
Dim fname As String
Dim mBody As String
Dim rng As Range
Dim rng1 As Range
Dim ws As Worksheet
Dim mailTo As String
 Set ws = Sheets("MRO")
 fname = ws.Range("B4")
 mSubject = "MRO " & " For " & Range("C6").Value
 Set OutApp = CreateObject("Outlook.Application")
 Set OutMail = OutApp.CreateItem(0)
'mBody = "2-SO\Material Request Form .xlsm"

Dim Path As String

 mBody = "<font size=""3"" face=""Calibri"">" & _
"Dear Team,<br><br>" & _
"Please open the file from below link and put your signature on the respective cell after you completed your task.<br><B>" & _
fileName & ".xlsm" & "</B> is created.<br>" & _
"Click on this link to open the file : " & _
"<A HREF=""file://" & Path & fileName & ".xlsm" & _
""">Files are saved here</A>" & "-->" & Range("C6").Value & _
"<br><br>Best Regards," & _
"<br><br></font>"

    With OutMail
     .display
    End With
 signature = OutMail.body
    With Application
     .EnableEvents = False
     .ScreenUpdating = False
    End With

    With OutMail
     '.To = "email"
     .To = ""
     .CC = ""
     .BCC = ""
     .Subject = mSubject
     '.body = "Dear Team," & vbCrLf & vbCrLf & "Please open the file from below link and put your signature on the respective cell and save the sheet"
     '.htmlbody = RangetoHTML(rng)
     .htmlbody = mBody
     '.Attachments.Add fileName
     .display
    End With
 'ws.PageSetup.RightHeader = "&""Calibri,italic""&11& " & ws.Range("A1")
 ActiveWorkbook.Close False
 ActiveWorkbook.Close
 On Error GoTo 0

 Set OutMail = Nothing
 Set OutApp = Nothing

    With Application
     .ScreenUpdating = True
     .EnableEvents = True
    End With

[DocAElstein]

Code in code tags from here:
http://www.excelfox.com/forum/showth...0699#post10699

Dim OutApp As Object
Dim OutMail As Object
Dim fileName As String
Dim mSubject As String
Dim signature As String
Dim fname As String
Dim mBody As String
Dim rng As Range
Dim rng1 As Range
Dim ws As Worksheet
Dim mailTo As String
 fname = ws.Range("A1")
 mSubject = "Equipment" & " For " & Range("A1").Value
 Set OutApp = CreateObject("Outlook.Application")
 Set OutMail = OutApp.CreateItem(0)
 'mBody = "Z:\2\Form\\Manufacturing Order.xlsm"

Dim Path As String
 ws.Protect ("Equipment")
 Path = "\\Equipment- Maint RecordsThai1.xlsm"
 mBody = "<font size=""3"" face=""Calibri"">" & _
   "Dear Team,<br><br>" & _
   "Please open the file from below link and change the date on the respective cell after you completed your task.<br><B>" & _
   fileName & ".xlsm" & "</B> is created.<br>" & _
   "Click on this link to open the file : " & _
   "<A HREF=""file://" & Path & fileName & ".xlsm" & _
   """>Files are saved here</A>" & "-->" & Range("A1").Value & _
   "<br><br>Best Regards," & _
   "<br><br></font>"

    With OutMail
     .display
    End With
 signature = OutMail.body
    With Application
     .EnableEvents = False
     .ScreenUpdating = False
    End With

Private Sub cmdNot_Click()
    If Application.UserName = "Thai Nguyen" Then
    Dim ws As Worksheet: Set ws = Sheets("Name")
    Dim rng As Range, rng1 As Range
    Dim fileName As String, fname As String
     Let fname = ws.Range("B4")
     Let mSubject = "Name"
    Dim OutApp As Object, OutMail As Object
     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)
    Dim Subject As String, signature As String, mBody As String, mailTo As String
        'mBody = "copy you link path in here"
     Let mBody = "<font size=""3"" face=""Calibri"">" & _
     "Hi Team,<br><br>" & _
     "Please open the file from below link and put your signature on the respective cell after you completed your task.<br><B>" & _
     ActiveWorkbook.Name & "</B> is created.<br>" & _
     "Click on this link to open the file : " & _
     "<A HREF=""file://" & ActiveWorkbook.FullName & """>Link to the file</A>" & _
     "<br><br>Regards," & _
     "<br><br>Thai Nguyen</font>    "
     OutMail.display
     Let signature = OutMail.body
        With Application
         .EnableEvents = False
         .ScreenUpdating = False
        End With
        With OutMail
        '.To = "email"
            If ws.Range("EU16") = True Then
             Let mailTo = mailTo + "Thai Nguyen;"
            Else
            End If
            If ws.Range("EU17") = True Then
            mailTo = mailTo + "email"
            End If
            If ws.Range("EU18") = True Then
             Let mailTo = mailTo + "email"
            End If
            If ws.Range("EU19") = True Then
             Let mailTo = mailTo + "email"
            End If
         .To = mailTo
         .CC = "Thai Nguyen"
         .BCC = ""
         .Subject = mSubject
         '.body = "Hi Team," & vbCrLf & vbCrLf & "Please open the file from below link and put your signature on the respective cell and save the sheet"
         '.htmlbody = RangetoHTML(rng)
         .htmlbody = mBody
         '.Attachments.Add fileName
         .display
        End With
     'ws.PageSetup.RightHeader = "&""Calibri,italic""&11& " & ws.Range("A1")
     ws.Protect ("Name")
     ActiveWorkbook.Save
     ActiveWorkbook.Close
     On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
        With Application
         .ScreenUpdating = True
         .EnableEvents = True
        End With
    Else
     MsgBox "You are not authorised to send BOM form, please check with BOM owner"
    End If
End Sub