Appendix Thread. ( Codes for other Threads, ( Avinash ).)
Array List Sort of Referrences
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
Code:
' 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
Modified initial function and additional second function for German telekom EMail workaround
Function codes discussed in this Post:
http://www.excelfox.com/forum/showth...0527#post10527
Code:
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
3 Attachment(s)
Example VBA available checked Libraries Info, (Helpful for Later Early Binding)
Some sample data for other Posts and Threads:
http://www.excelfox.com/forum/showth...ing-Techniques
Using this code: _..
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:
Code:
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
Checked Library Infomation Excel 2003 Excel 2007 Excel 2010
Some sample data for other Posts and Threads:
http://www.eileenslounge.com/viewtopic.php?f=30&t=29652
Using this code:
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
Code:
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
Code:
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
Code:
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
Uploading Files at excelfox
_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..
1 Attachment(s)
Re Post code with Code tags
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:
Code:
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
