Notes tests. Application.Run.OnTime Multiple Variable Arguments ByRef ByVal

[DocAElstein]

Per PM request: One full working example of above code:

Option Explicit
Rem 1 ' This I understand. it is a simple more basic version of the VBA Message Box Function                                       http://www.eileenslounge.com/viewtopic.php?f=18&t=28885#p223629
' 1a)          UnWRap it and..
Private Declare Function APIssinUserDLL_MsgBox Lib "user32" Alias "MessageBoxA" (Optional ByVal HowManyFartsCanYouHandle As Long, Optional ByVal Prompt As String, Optional ByVal Title As String, Optional ByVal buttons As Long) As Long '
' 1b)        To hang in the Excel Window malking it effectively a Excel Msgbox... Normally if I did not do this  ... don't do this .. that is to say leave it at 0 , specifically no window is 0 , and it "hanging in mid air so isn't even if it is   imaginatively speaking
Public Declare Function FindWndNumber Lib "user32" Alias "FindWindowA" (Optional ByVal lpClassName As String, Optional ByVal lpWindowName As String) As Long
Dim HandleWndOfMyParent As Long      ' I wanted to comment  this  1b)(i) and ( 1b(ii) later )   out to leave it hanging in mid air in a virtual  inadvirtual not thereness  ... but somehow this complicated hook stuff does hang it somwhere but not in my Excel Window                                                                                                            but I don't know what my parent's fart has to do with anything
' 1d)        For some Misc experiments
Private Declare Function FindWindowExtremeNutty Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Dim WndNumber As Long, hWndDskTop As Long
Dim Booloks As Boolean
'_-_._______________________________________________-
'_-=================??? main Declarations that I don't really understand
Rem 2 Position my box --- From here on I do not really have a clue
' 2(a)                                        This will tie something on the chain for when you pull it                                                                                                      https://msdn.microsoft.com/en-us/library/windows/desktop/ms644990(v=vs.85).aspx
Private Declare Function SetWindowsHooksExample Lib "user32" Alias "SetWindowsHookExA" (ByVal Hooktype As Long, ByVal lokprocedureAddress As Long, Optional ByVal hmod As Long, Optional ByVal dwThreadId As Long) As Long
' 2(b)                                        Wipe the chain clean
Private Declare Function UnHookWindowsHookCodEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal hHookTrapCrapNumber As Long) As Long
' 2(c)                                        Don't loose the Thread? - This seems to have no effect , - maybe it would if something else was going on at the time. You don't want to loose the Thread I guess
'Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long ' Effectively long Null acttuall not ?? -
Public Declare Function GetCurrentFredId Lib "kernel32" Alias "GetCurrentThreadId" () As Long ' Effectively long Null acttuall not ?? -
' 2(d)                                        This looks understandable almost, z(0 for top), posLeft, posTop, x pixels, y pixels,
Private Declare Function SetWindowPosition Lib "user32" Alias "SetWindowPos" (ByVal hWnd As Long, ByVal zNumber As Long, ByVal CoedX As Long, ByVal CoedY As Long, ByVal xPiXel As Long, ByVal yPiYel As Long, ByVal wFlags As Long) As Long
' 2e)
Private hHookTrapCrapNumber As Long                         ' Handle to the Hook procedure
' 2f)
Private poX As Long: Private pussY As Long    ' Positional By proXYs
                            Dim GlobinalCntChopsLog As Long   ' Only used in this test code to keep track of the copies of a Function(HoldYaBackCalledYaBackClapTrap) used in a recursion process
' 2g) bits to do with 1 that i am resonably happy with
Sub AkaApiApplicationPromptToRangeInputBox()  ' This one works.. but HTF
        ' 1b(ii)  This section is some how over written in / by the section part or some strange Addressing of HoldYaBackCalledYaBackClapTrap
         Let WndNumber = FindWndNumber(lpClassName:=vbNullString, lpWindowName:=vbNullString)
         Let HandleWndOfMyParent = FindWndNumber(lpClassName:="XLMAIN", lpWindowName:=vbNullString) ' This is a case where vbNullstring is important - that signifies that I am not giving it, which i do not have to. The second option is a bit flaky and does not often work. it certainly won't work if you make it "" as that is a specific string of zero.  Null  is a special idea in computing of not set yet / not defined - that is required if I do not want to give it
        ' 1d) Just some experiments, I forgot why as my brain has goine comfortably numb
         Dim HeavyWindBreak As Long: Let HeavyWindBreak = HandleWndOfMyParent
         Let hWndDskTop = FindWindowExtremeNutty(HandleWndOfMyParent, 0&, "XLDESK", vbNullString)
                            Debug.Print "WndNumber"; WndNumber; "   HandleWndOfMyParent"; HandleWndOfMyParent; "   hWndDskTop"; hWndDskTop; "   hHookTrapCrapNumber"
Rem 3                                   Mess with me hook? God knows what this all does and it seems to make no difference if the proXYs poX or pussY are before or after SetWindowsHooksExample
                            Debug.Print "State of Much Such"; Tab(20); "Penialtration's Number"; Tab(45); "HookCodeXcretion's"
                            Debug.Print "=================="; Tab(20); "AliAs Pull of my chain"; Tab(45); "AliAs my long Hook"
                            Let GlobinalCntChopsLog = 0:
'_-======================== Weird thing with an AddressOf ???
Let poX = 10: pussY = 50 ' These can go before or after the next line, makes no diffference.. -                                                    I bet no Pro noticed that...
'Let hHookTrapCrapNumber = SetWindowsHooksExample(5, AddressOf HoldYaBackCalledYaBackClapTrap, 0, GetCurrentThreadId)   ' (5-pull before flush,  somehow arranges that the function gets called  ,
                            Debug.Print ; Tab(75); hHookTrapCrapNumber '                                                                                           'APIssinUserDLL_MsgBox HeavyWindBreak, "Excel MsgBox", "This is Center Position", vbOKOnly ' This breaks Wnd in Excel Window
 Call HookAPIssinUserDLL_MsgBoxThenDropIt
 'APIssinUserDLL_MsgBox &H0, "Select Range", "MutsNuts AkaApi working ApplicationPromptToRangeInputBox", vbOKOnly ' Pseudo Non Modal
 'APIssinUserDLL_MsgBox &H0, "Select Range", "MutsNuts AkaApi working ApplicationPromptToRangeInputBox", vbOKOnly ' Pseudo Non Modal
 'HookAPIssinUserDLL_MsgBoxThenDropIt
                                                                                                          
                                                                                                          Dim Rng As Range: Set Rng = Selection
' (Optional ByVal hwnd As Long, Optional ByVal Prompt As String, Optional ByVal Title As String, Optional ByVal buttons As Long) As Long '
End Sub ' AkaApiApplicationPromptToRangeInputBox
Sub HookAPIssinUserDLL_MsgBoxThenDropIt()

Sub HookAPIssinUserDLL_MsgBoxThenDropIt()
' a) HOOK Hook the pseudo Windows Sub Class Function WinSubWinCls_JerkBackOffHooKerd
Dim BookMarkClassTeachMeWind As Long: Let BookMarkClassTeachMeWind = 5
 'Let hHookTrapCrapNumber = SetWindowsHooksExample(BookMarkClassTeachMeWind, AddressOf HoldYaBackCalledYaBackClapTraped, 0, GetCurrentThreadId)   ' (5-pull before flush,  somehow arranges that the function gets called  ,
 'Let hHookTrapCrapNumber = SetWindowsHooksExample(BookMarkClassTeachMeWind, AddressOf HoldYaBackCalledYaBackClapTrapRuc, 0, GetCurrentThreadId)   ' (5-pull before flush,  somehow arranges that the function gets called  ,
 Let hHookTrapCrapNumber = SetWindowsHooksExample(BookMarkClassTeachMeWind, AddressOf HoldYaBackCalledYaBackClapTrapRuc, 0, GetCurrentFredId)   ' (5-pull before flush,  somehow arranges that the function gets called  ,
' b) Call the MessageBoxA
 APIssinUserDLL_MsgBox &H0, "Select Range", "MutsNuts AkaApi working ApplicationPromptToRangeInputBox", vbOKOnly ' Pseudo Non Modal
End Sub
'_-=Rem 4===================??? Got me hook lochprocedue in my code ,                5 times simple run then  another + 29 new copies of it are run  = 6+29=35 times  in total                     calling it it a few times  http://www.excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA#post10421   .... wanking myself up and down a few times

'_-=Rem 4===================??? Got me hook lochprocedue in my code ,                5 times simple run then  another + 29 new copies of it are run  = 5+30=35 times  in total                     calling it it a few times  http://www.excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA#post10421   .... wanking myself up and down a few times
Private Function HoldYaBackCalledYaBackClapTrapRuc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long   '                                   ByVal CopyNumberFroNxtLvl As Long) As Long
                            Let GlobinalCntChopsLog = GlobinalCntChopsLog + 1: Debug.Print " Going a HoldYaBackCalledYaBackClapTrapRuc"; GlobinalCntChopsLog; "(1Msg"; lMsg; ", wParam"; wParam; ", lParam"; lParam; ") Function Copy Number_"; GlobinalCntChopsLog
                            'If GlobinalCntChopsLog = 2 Then Let GlobinalCntChopsLog = GlobinalCntChopsLog - 1: UnHookWindowsHookCodEx hHookTrapCrapNumber: Exit Function
    If lMsg = 5 Then '_-.... ( Hook type: HCBT_ACTIVATE = 5 but not here?) ... this runs a further 29 copies of HoldYaBackCalledYaBackClapTrap all coming here, so 30 times in total
                            Debug.Print "Expose Interface"; Tab(30); GlobinalCntChopsLog
     Call SetWindowPosition(wParam, 0, poX, pussY, 400, 150, 40) '             SWP_NOZORDER is 4 ..  but not here?? 'SWP_NOSIZE + SWP_NOZORDER ' Pull the Chainge position ...
     UnHookWindowsHookCodEx hHookTrapCrapNumber         ' Release the Hook 30 times this is done
    Else
                            Debug.Print "No InterOfCourse"; Tab(30); GlobinalCntChopsLog; Tab(50); hHookTrapCrapNumber
    End If ' 5 times here then '_-....
                            Debug.Print "Wipe chain WRap"; Tab(30); GlobinalCntChopsLog; Tab(50); hHookTrapCrapNumber
    Let HoldYaBackCalledYaBackClapTrapRuc = 0 '  Done  5+30=35 times in total  '0 (or False) makes it work, all other numbers and I get no Message box
                            Let GlobinalCntChopsLog = GlobinalCntChopsLog - 1
End Function ' HoldYaBackCalledYaBackClapTrapRuc

[DocAElstein]

Per PM request: One full working example of above code:

Option Explicit
Rem 1 ' This I understand. it is a simple more basic version of the VBA Message Box Function                                       http://www.eileenslounge.com/viewtopic.php?f=18&t=28885#p223629
' 1a)          UnWRap it and..
Private Declare Function APIssinUserDLL_MsgBox Lib "user32" Alias "MessageBoxA" (Optional ByVal HowManyFartsCanYouHandle As Long, Optional ByVal Prompt As String, Optional ByVal Title As String, Optional ByVal buttons As Long) As Long '
' 1b)        To hang in the Excel Window malking it effectively a Excel Msgbox... Normally if I did not do this  ... don't do this .. that is to say leave it at 0 , specifically no window is 0 , and it "hanging in mid air so isn't even if it is   imaginatively speaking
Public Declare Function FindWndNumber Lib "user32" Alias "FindWindowA" (Optional ByVal lpClassName As String, Optional ByVal lpWindowName As String) As Long
Dim HandleWndOfMyParent As Long      ' I wanted to comment  this  1b)(i) and ( 1b(ii) later )   out to leave it hanging in mid air in a virtual  inadvirtual not thereness  ... but somehow this complicated hook stuff does hang it somwhere but not in my Excel Window                                                                                                            but I don't know what my parent's fart has to do with anything
' 1d)        For some Misc experiments
Private Declare Function FindWindowExtremeNutty Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Dim WndNumber As Long, hWndDskTop As Long
Dim Booloks As Boolean
'_-_._______________________________________________-
'_-=================??? main Declarations that I don't really understand
Rem 2 Position my box --- From here on I do not really have a clue
' 2(a)                                        This will tie something on the chain for when you pull it                                                                                                      https://msdn.microsoft.com/en-us/library/windows/desktop/ms644990(v=vs.85).aspx
Private Declare Function SetWindowsHooksExample Lib "user32" Alias "SetWindowsHookExA" (ByVal Hooktype As Long, ByVal lokprocedureAddress As Long, Optional ByVal hmod As Long, Optional ByVal dwThreadId As Long) As Long
' 2(b)                                        Wipe the chain clean
Private Declare Function UnHookWindowsHookCodEx Lib "user32" Alias "UnhookWindowsHookEx" (ByVal hHookTrapCrapNumber As Long) As Long
' 2(c)                                        Don't loose the Thread? - This seems to have no effect , - maybe it would if something else was going on at the time. You don't want to loose the Thread I guess
'Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long ' Effectively long Null acttuall not ?? -
Public Declare Function GetCurrentFredId Lib "kernel32" Alias "GetCurrentThreadId" () As Long ' Effectively long Null acttuall not ?? -
' 2(d)                                        This looks understandable almost, z(0 for top), posLeft, posTop, x pixels, y pixels,
Private Declare Function SetWindowPosition Lib "user32" Alias "SetWindowPos" (ByVal hWnd As Long, ByVal zNumber As Long, ByVal CoedX As Long, ByVal CoedY As Long, ByVal xPiXel As Long, ByVal yPiYel As Long, ByVal wFlags As Long) As Long
' 2e)
Private hHookTrapCrapNumber As Long                         ' Handle to the Hook procedure
' 2f)
Private poX As Long: Private pussY As Long    ' Positional By proXYs
                            Dim GlobinalCntChopsLog As Long   ' Only used in this test code to keep track of the copies of a Function(HoldYaBackCalledYaBackClapTrap) used in a recursion process
' 2g) bits to do with 1 that i am resonably happy with
Sub AkaApiApplicationPromptToRangeInputBox()  ' This one works.. but HTF
        ' 1b(ii)  This section is some how over written in / by the section part or some strange Addressing of HoldYaBackCalledYaBackClapTrap
         Let WndNumber = FindWndNumber(lpClassName:=vbNullString, lpWindowName:=vbNullString)
         Let HandleWndOfMyParent = FindWndNumber(lpClassName:="XLMAIN", lpWindowName:=vbNullString) ' This is a case where vbNullstring is important - that signifies that I am not giving it, which i do not have to. The second option is a bit flaky and does not often work. it certainly won't work if you make it "" as that is a specific string of zero.  Null  is a special idea in computing of not set yet / not defined - that is required if I do not want to give it
        ' 1d) Just some experiments, I forgot why as my brain has goine comfortably numb
         Dim HeavyWindBreak As Long: Let HeavyWindBreak = HandleWndOfMyParent
         Let hWndDskTop = FindWindowExtremeNutty(HandleWndOfMyParent, 0&, "XLDESK", vbNullString)
                            Debug.Print "WndNumber"; WndNumber; "   HandleWndOfMyParent"; HandleWndOfMyParent; "   hWndDskTop"; hWndDskTop; "   hHookTrapCrapNumber"
Rem 3                                   Mess with me hook? God knows what this all does and it seems to make no difference if the proXYs poX or pussY are before or after SetWindowsHooksExample
                            Debug.Print "State of Much Such"; Tab(20); "Penialtration's Number"; Tab(45); "HookCodeXcretion's"
                            Debug.Print "=================="; Tab(20); "AliAs Pull of my chain"; Tab(45); "AliAs my long Hook"
                            Let GlobinalCntChopsLog = 0:
'_-======================== Weird thing with an AddressOf ???
Let poX = 10: pussY = 50 ' These can go before or after the next line, makes no diffference.. -                                                    I bet no Pro noticed that...
'Let hHookTrapCrapNumber = SetWindowsHooksExample(5, AddressOf HoldYaBackCalledYaBackClapTrap, 0, GetCurrentThreadId)   ' (5-pull before flush,  somehow arranges that the function gets called  ,
                            Debug.Print ; Tab(75); hHookTrapCrapNumber '                                                                                           'APIssinUserDLL_MsgBox HeavyWindBreak, "Excel MsgBox", "This is Center Position", vbOKOnly ' This breaks Wnd in Excel Window
 Call HookAPIssinUserDLL_MsgBoxThenDropIt
 'APIssinUserDLL_MsgBox &H0, "Select Range", "MutsNuts AkaApi working ApplicationPromptToRangeInputBox", vbOKOnly ' Pseudo Non Modal
 'APIssinUserDLL_MsgBox &H0, "Select Range", "MutsNuts AkaApi working ApplicationPromptToRangeInputBox", vbOKOnly ' Pseudo Non Modal
 'HookAPIssinUserDLL_MsgBoxThenDropIt
                                                                                                          
                                                                                                          Dim Rng As Range: Set Rng = Selection
' (Optional ByVal hwnd As Long, Optional ByVal Prompt As String, Optional ByVal Title As String, Optional ByVal buttons As Long) As Long '
End Sub ' AkaApiApplicationPromptToRangeInputBox
Sub HookAPIssinUserDLL_MsgBoxThenDropIt()

Sub HookAPIssinUserDLL_MsgBoxThenDropIt()
' a) HOOK Hook the pseudo Windows Sub Class Function WinSubWinCls_JerkBackOffHooKerd
Dim BookMarkClassTeachMeWind As Long: Let BookMarkClassTeachMeWind = 5
 'Let hHookTrapCrapNumber = SetWindowsHooksExample(BookMarkClassTeachMeWind, AddressOf HoldYaBackCalledYaBackClapTraped, 0, GetCurrentThreadId)   ' (5-pull before flush,  somehow arranges that the function gets called  ,
 'Let hHookTrapCrapNumber = SetWindowsHooksExample(BookMarkClassTeachMeWind, AddressOf HoldYaBackCalledYaBackClapTrapRuc, 0, GetCurrentThreadId)   ' (5-pull before flush,  somehow arranges that the function gets called  ,
 Let hHookTrapCrapNumber = SetWindowsHooksExample(BookMarkClassTeachMeWind, AddressOf HoldYaBackCalledYaBackClapTrapRuc, 0, GetCurrentFredId)   ' (5-pull before flush,  somehow arranges that the function gets called  ,
' b) Call the MessageBoxA
 APIssinUserDLL_MsgBox &H0, "Select Range", "MutsNuts AkaApi working ApplicationPromptToRangeInputBox", vbOKOnly ' Pseudo Non Modal
End Sub
'_-=Rem 4===================??? Got me hook lochprocedue in my code ,                5 times simple run then  another + 29 new copies of it are run  = 6+29=35 times  in total                     calling it it a few times  http://www.excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA#post10421   .... wanking myself up and down a few times

'_-=Rem 4===================??? Got me hook lochprocedue in my code ,                5 times simple run then  another + 29 new copies of it are run  = 5+30=35 times  in total                     calling it it a few times  http://www.excelfox.com/forum/showthread.php/1324-Loop-Through-Files-In-A-Folder-Using-VBA#post10421   .... wanking myself up and down a few times
Private Function HoldYaBackCalledYaBackClapTrapRuc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long   '                                   ByVal CopyNumberFroNxtLvl As Long) As Long
                            Let GlobinalCntChopsLog = GlobinalCntChopsLog + 1: Debug.Print " Going a HoldYaBackCalledYaBackClapTrapRuc"; GlobinalCntChopsLog; "(1Msg"; lMsg; ", wParam"; wParam; ", lParam"; lParam; ") Function Copy Number_"; GlobinalCntChopsLog
                            'If GlobinalCntChopsLog = 2 Then Let GlobinalCntChopsLog = GlobinalCntChopsLog - 1: UnHookWindowsHookCodEx hHookTrapCrapNumber: Exit Function
    If lMsg = 5 Then '_-.... ( Hook type: HCBT_ACTIVATE = 5 but not here?) ... this runs a further 29 copies of HoldYaBackCalledYaBackClapTrap all coming here, so 30 times in total
                            Debug.Print "Expose Interface"; Tab(30); GlobinalCntChopsLog
     Call SetWindowPosition(wParam, 0, poX, pussY, 400, 150, 40) '             SWP_NOZORDER is 4 ..  but not here?? 'SWP_NOSIZE + SWP_NOZORDER ' Pull the Chainge position ...
     UnHookWindowsHookCodEx hHookTrapCrapNumber         ' Release the Hook 30 times this is done
    Else
                            Debug.Print "No InterOfCourse"; Tab(30); GlobinalCntChopsLog; Tab(50); hHookTrapCrapNumber
    End If ' 5 times here then '_-....
                            Debug.Print "Wipe chain WRap"; Tab(30); GlobinalCntChopsLog; Tab(50); hHookTrapCrapNumber
    Let HoldYaBackCalledYaBackClapTrapRuc = 0 '  Done  5+30=35 times in total  '0 (or False) makes it work, all other numbers and I get no Message box
                            Let GlobinalCntChopsLog = GlobinalCntChopsLog - 1
End Function ' HoldYaBackCalledYaBackClapTrapRuc

[DocAElstein]

Code solution for this Thread
http://www.excelfox.com/forum/showth...e-page-numbers
https://www.excelforum.com/excel-pro...d-numbers.html

Option Explicit
Sub Moshe() ' http://www.excelfox.com/forum/showthread.php/2229-complete-page-numbers
Rem 1 Make array for holding inoput data and output data -  ' Input data can be handled as simple text so Array work is satisfactory
Dim arrIn() As Variant ' We know the data type can be taken as string, but I want to get the data quickly in a spreadsheet "capture" type way, using the .Value Property applied to a range object which returns a field of values for more than 1 cell returns a field of values held in Variant types, - so the type must be variant or a type mismatch runtime error will occcur
 Let arrIn() = Range("A1:A" & Range("A1").CurrentRegion.Rows.Count & "").Value
Dim arrOut() As String: ReDim arrOut(1 To UBound(arrIn())) ' I can use string type to suit my final data. I also know the array size, but I must make the array a dynamic ( unknown size ) type as the Dim declare statement will only take actual numbers, but I determine my size from the size of the input array by UBound(arrIn()) : the ReDim method will accept the UBound(arrIn()) , wheras the Dim declaration syntax will not accept this, as the Dim is done at complie and not runtime
Rem 2 Effectively looping for each data row
Dim Cnt As Long ' For going through each "row"
    For Cnt = 1 To UBound(arrIn()) ' Going through each element in arrIn()
    '2a) split the data in a cell into an array of data. The VBA strings collection split function will return a 1 dimentsional array of string types starting at indicie 0
    Dim spltEnt() As String ' For the string row split into each number entry, in other words an array of the data in a cell
        If InStr(1, arrIn(Cnt, 1), ", ", vbBinaryCompare) <> 0 Then ' case more than 1 entry in cell. starting at the first character  ,   in the current Cnt array element  , I look for  ", "   , stipulating an excact computer match search type         This Function will return eitheer the position counting from the left that it finds the first ", " or it will return 0 if it does not find at least one occurance of the ", "
         Let spltEnt() = VBA.Strings.Split(arrIn(Cnt, 1), ", ", -1, vbBinaryCompare) ' we now have a number or number pair
        Else ' case a single entry I cannot split by a ", " as i don't have any, ...
         ReDim spltEnt(0): Let spltEnt(0) = arrIn(Cnt, 1) ' ... so i just make a single element array and put the single element in it
        End If
    '2b) working through each data part in a cell
    Dim strOut As String 'String in each "row" '_-"Pointer" to a "Blue Print" (or Form, Questionaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, 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. A String is a a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
    Dim CntX As Long '                         '_-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
        For CntX = 0 To UBound(spltEnt()) ' for going through each entry in a row in other words for going through each piece of data in a cell
        '2c)(i) case just data for a single page
            If InStr(1, spltEnt(CntX), "-", vbBinaryCompare) = 0 Then ' case of no "-"
             Let strOut = strOut & spltEnt(CntX) & ", " ' just the single number goes in the output string, strOut
            Else ' we have a "-"
            Dim NmbrPear() As String ' this will be am Array of 2 elements for each number pair
             Let NmbrPear() = VBA.Strings.Split(spltEnt(CntX), "-", -1, vbBinaryCompare)
             '2c)(ii) case no correction needed in the data
                If Len(NmbrPear(0)) = Len(NmbrPear(1)) Then ' the numbers are the same
                 Let strOut = strOut & spltEnt(CntX) & ", "  ' the same number pair goes in the output string
                Else ' from here on, we need to do some adjustment before adding to the output string
             '2c)(iii) cases data correction needed
                 Select Case Len(NmbrPear(0)) - Len(NmbrPear(1)) ' selecting the case of the difference in length of the two parts of the data "FirstNumberPart-SecondNumberPart"
                  Case 1 ' Like 123-24 or 12345-2345
                   Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 1) & NmbrPear(1) ' like 1 & 24 or 1 & 2345 ' VBA strings collection Mid Function: This returns the part of  (   NmbrPear(0)    ,   the starts at character 1    ,    and has the length of 1 character     )
                  Case 2 ' like 123-4
                   Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 2) & NmbrPear(1) ' like 12 & 4
                  Case 3 ' like 1234-6
                   Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 3) & NmbrPear(1) ' like 123 & 6
                  Case 3 ' like 12345-8
                   Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 4) & NmbrPear(1) ' like 1234 & 8
                 End Select ' at this point we have corrected our second number part from the pair
                Let strOut = strOut & VBA.Strings.Join(NmbrPear(), "-") & ", " ' The number pair is rejoined with the corrected second number part before adding the number parts pair to the output string
                End If
             End If
        Next CntX
    '2d) The string of corrected data can now be added to the array for output
     Let strOut = VBA.Strings.Left$(strOut, Len(strOut) - 2) ' This removes the last unwanted ", "   ' 'VBA Strings collection Left function returns a Variant- initially tries to coerces the first parameter into Variant, Left$ does not, that's why Left$ is preferable over Left, it's theoretically slightly more efficient, as it avoids the overhead/inefficieny associated with the Variant. It allows a Null to be returned if a Null is given. https://www.excelforum.com/excel-new...ml#post4084816 .. it is all to do with ya .."Null propagation".. maties ;) '_-.. http://allenbrowne.com/casu-12.html Null is a special "I do not know, / answer unknown" - handy to hav... propogetion wonks - math things like = 1+2+Null returns you null. Or string manipulation stuff like, left(Null returns you Null. Count things like Cnt (x,y,Null) will return 2 - there are two known things there..Hmm - bit iffy although you could argue that Null has not been entered yet.. may never
     Let arrOut(Cnt) = strOut ' Finally the string is aded to the current "row" in the  outout array
     Let strOut = "" ' Empty variable holding a row string for use ijn next loop
    Next Cnt
Rem 3 I have the final data array, and so umst now paste it out where I want it.
Dim arrClmOut() As String: ReDim arrClmOut(1 To UBound(arrOut), 1 To 1) ' This is for a 1 column 2 Dimensional array which I need for the orientation of my final output
'3(i) a simple loop to fill the transposed array
Dim rCnt As Long '
    For rCnt = 1 To UBound(arrOut())
     Let arrClmOut(rCnt, 1) = arrOut(rCnt)
    Next rCnt
'3(ii) Output to worksheet
 Let Range("B1").Resize(UBound(arrOut())).Value = arrClmOut() ' The cell Top left of where the output should go is resized to the required row size, and 1 column. The .Value Property of that range object may have the values in an Array assigned to it in a simpla one line assignment
End Sub
'
'
'
'   http://www.excelfox.com/forum/showthread.php/2157-Re-Defining-multiple-variables-in-VBA?p=10192#post10192
'   https://www.excelforum.com/word-programming-vba-macros/1175184-vba-word-repeat-character-in-string-a-number-of-times.html#post4591171

[DocAElstein]

Code solution for this Thread
http://www.excelfox.com/forum/showth...e-page-numbers
https://www.excelforum.com/excel-pro...d-numbers.html

Option Explicit
Sub Moshe() ' http://www.excelfox.com/forum/showthread.php/2229-complete-page-numbers
Rem 1 Make array for holding inoput data and output data -  ' Input data can be handled as simple text so Array work is satisfactory
Dim arrIn() As Variant ' We know the data type can be taken as string, but I want to get the data quickly in a spreadsheet "capture" type way, using the .Value Property applied to a range object which returns a field of values for more than 1 cell returns a field of values held in Variant types, - so the type must be variant or a type mismatch runtime error will occcur
 Let arrIn() = Range("A1:A" & Range("A1").CurrentRegion.Rows.Count & "").Value
Dim arrOut() As String: ReDim arrOut(1 To UBound(arrIn())) ' I can use string type to suit my final data. I also know the array size, but I must make the array a dynamic ( unknown size ) type as the Dim declare statement will only take actual numbers, but I determine my size from the size of the input array by UBound(arrIn()) : the ReDim method will accept the UBound(arrIn()) , wheras the Dim declaration syntax will not accept this, as the Dim is done at complie and not runtime
Rem 2 Effectively looping for each data row
Dim Cnt As Long ' For going through each "row"
    For Cnt = 1 To UBound(arrIn()) ' Going through each element in arrIn()
    '2a) split the data in a cell into an array of data. The VBA strings collection split function will return a 1 dimentsional array of string types starting at indicie 0
    Dim spltEnt() As String ' For the string row split into each number entry, in other words an array of the data in a cell
        If InStr(1, arrIn(Cnt, 1), ", ", vbBinaryCompare) <> 0 Then ' case more than 1 entry in cell. starting at the first character  ,   in the current Cnt array element  , I look for  ", "   , stipulating an excact computer match search type         This Function will return eitheer the position counting from the left that it finds the first ", " or it will return 0 if it does not find at least one occurance of the ", "
         Let spltEnt() = VBA.Strings.Split(arrIn(Cnt, 1), ", ", -1, vbBinaryCompare) ' we now have a number or number pair
        Else ' case a single entry I cannot split by a ", " as i don't have any, ...
         ReDim spltEnt(0): Let spltEnt(0) = arrIn(Cnt, 1) ' ... so i just make a single element array and put the single element in it
        End If
    '2b) working through each data part in a cell
    Dim strOut As String 'String in each "row" '_-"Pointer" to a "Blue Print" (or Form, Questionaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, 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. A String is a a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks.. But..http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
    Dim CntX As Long '                         '_-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
        For CntX = 0 To UBound(spltEnt()) ' for going through each entry in a row in other words for going through each piece of data in a cell
        '2c)(i) case just data for a single page
            If InStr(1, spltEnt(CntX), "-", vbBinaryCompare) = 0 Then ' case of no "-"
             Let strOut = strOut & spltEnt(CntX) & ", " ' just the single number goes in the output string, strOut
            Else ' we have a "-"
            Dim NmbrPear() As String ' this will be am Array of 2 elements for each number pair
             Let NmbrPear() = VBA.Strings.Split(spltEnt(CntX), "-", -1, vbBinaryCompare)
             '2c)(ii) case no correction needed in the data
                If Len(NmbrPear(0)) = Len(NmbrPear(1)) Then ' the numbers are the same
                 Let strOut = strOut & spltEnt(CntX) & ", "  ' the same number pair goes in the output string
                Else ' from here on, we need to do some adjustment before adding to the output string
             '2c)(iii) cases data correction needed
                 Select Case Len(NmbrPear(0)) - Len(NmbrPear(1)) ' selecting the case of the difference in length of the two parts of the data "FirstNumberPart-SecondNumberPart"
                  Case 1 ' Like 123-24 or 12345-2345
                   Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 1) & NmbrPear(1) ' like 1 & 24 or 1 & 2345 ' VBA strings collection Mid Function: This returns the part of  (   NmbrPear(0)    ,   the starts at character 1    ,    and has the length of 1 character     )
                  Case 2 ' like 123-4
                   Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 2) & NmbrPear(1) ' like 12 & 4
                  Case 3 ' like 1234-6
                   Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 3) & NmbrPear(1) ' like 123 & 6
                  Case 3 ' like 12345-8
                   Let NmbrPear(1) = VBA.Strings.Mid$(NmbrPear(0), 1, 4) & NmbrPear(1) ' like 1234 & 8
                 End Select ' at this point we have corrected our second number part from the pair
                Let strOut = strOut & VBA.Strings.Join(NmbrPear(), "-") & ", " ' The number pair is rejoined with the corrected second number part before adding the number parts pair to the output string
                End If
             End If
        Next CntX
    '2d) The string of corrected data can now be added to the array for output
     Let strOut = VBA.Strings.Left$(strOut, Len(strOut) - 2) ' This removes the last unwanted ", "   ' 'VBA Strings collection Left function returns a Variant- initially tries to coerces the first parameter into Variant, Left$ does not, that's why Left$ is preferable over Left, it's theoretically slightly more efficient, as it avoids the overhead/inefficieny associated with the Variant. It allows a Null to be returned if a Null is given. https://www.excelforum.com/excel-new...ml#post4084816 .. it is all to do with ya .."Null propagation".. maties ;) '_-.. http://allenbrowne.com/casu-12.html Null is a special "I do not know, / answer unknown" - handy to hav... propogetion wonks - math things like = 1+2+Null returns you null. Or string manipulation stuff like, left(Null returns you Null. Count things like Cnt (x,y,Null) will return 2 - there are two known things there..Hmm - bit iffy although you could argue that Null has not been entered yet.. may never
     Let arrOut(Cnt) = strOut ' Finally the string is aded to the current "row" in the  outout array
     Let strOut = "" ' Empty variable holding a row string for use ijn next loop
    Next Cnt
Rem 3 I have the final data array, and so umst now paste it out where I want it.
Dim arrClmOut() As String: ReDim arrClmOut(1 To UBound(arrOut), 1 To 1) ' This is for a 1 column 2 Dimensional array which I need for the orientation of my final output
'3(i) a simple loop to fill the transposed array
Dim rCnt As Long '
    For rCnt = 1 To UBound(arrOut())
     Let arrClmOut(rCnt, 1) = arrOut(rCnt)
    Next rCnt
'3(ii) Output to worksheet
 Let Range("B1").Resize(UBound(arrOut())).Value = arrClmOut() ' The cell Top left of where the output should go is resized to the required row size, and 1 column. The .Value Property of that range object may have the values in an Array assigned to it in a simpla one line assignment
End Sub
'
'
'
'   http://www.excelfox.com/forum/showthread.php/2157-Re-Defining-multiple-variables-in-VBA?p=10192#post10192
'   https://www.excelforum.com/word-programming-vba-macros/1175184-vba-word-repeat-character-in-string-a-number-of-times.html#post4591171

[DocAElstein]

Code for this Thread:
http://www.excelfox.com/forum/showth...0503#post10503
http://www.excelfox.com/forum/forumd...ips-and-Tricks


Function CStrSepDbl

'10   '   http://www.eileenslounge.com/viewtopic.php?f=27&t=22850#p208624
Function CStrSepDbl(Optional ByVal strNumber As String) As Double '    Return a Double based on a String Input which is asssumed to "Look" like a Number. The code will work for Leading and Trailing zeros, but will not return them. )
20   Rem 0        At the Dim stage  a  '_-String  is "Pointer" to a "Blue Print" (or Form, Questionaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, 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. A String is a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks, But http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
30     If StrPtr(strNumber) = 0 Then Let CStrSepDbl = "9999999999": Exit Function '_- StrPtr(MyVaraibleNotYetUsed)=0 ..  http://www.excelfox.com/forum/showthread.php/1828-How-To-React-To-The-Cancel-Button-in-a-VB-(not-Application)-InputBox?p=10463#post10463       https://www.mrexcel.com/forum/excel-questions/35206-test-inputbox-cancel-2.html?highlight=strptr#post2845398    https://www.mrexcel.com/forum/excel-questions/917689-passing-array-class-byval-byref.html#post4412382
40   Rem 1  'Adding a leading zero if no number before a comma or point, change all seperators to comma  ,
50     If VBA.Strings.Left$(strNumber, 1) = "," Or VBA.Strings.Left$(strNumber, 1) = "." Then Let strNumber = "0" & strNumber  ' case for like .12  or ,7   etc 'VBA Strings collection Left function returns a Variant- initially tries to coerces the first parameter into Variant, Left$ does not, that's why Left$ is preferable over Left, it's theoretically slightly more efficient, as it avoids the overhead/inefficieny associated with the Variant. It allows a Null to be returned if a Null is given. https://www.excelforum.com/excel-new...ml#post4084816 .. it is all to do with ya .."Null propagation".. maties ;) '_-.. http://allenbrowne.com/casu-12.html Null is a special "I do not know, / answer unknown" - handy to hav... propogetion wonks - math things like = 1+2+Null returns you null. Or string manipulation stuff like, left(Null returns you Null. Count things like Cnt (x,y,Null) will return 2 - there are two known things there..Hmm -bit iffy although you could argue that Null has not been entered yet..may never
60     If VBA.Strings.Left$(strNumber, 2) = "-," Or VBA.Strings.Left$(strNumber, 2) = "-." Then Let strNumber = Application.WorksheetFunction.Replace(strNumber, 1, 1, "-0") ' case for like  -.12  or -,274   etc
70    Let strNumber = Replace(strNumber, ".", ",", 1, -1, vbBinaryCompare) 'Replace at start any . to a ,  After this point there should be either no or any amount of ,
80     'Check If a Seperator is present, then MAIN CODE is done
90     If InStr(1, strNumber, ",") > 0 Then 'Check we have at least one seperator, case we have, then..
100  Rem 2 'MAIN CODE part ====
110    'Length of String:  Position of last ( Decimal ) Seperator
120    Dim LenstrNumber As Long: Let LenstrNumber = Len(strNumber): Dim posDecSep As Long: Let posDecSep = VBA.Strings.InStrRev(strNumber, ",", LenstrNumber) '  from right the positom "along" from left  (   (in strNumber)  ,  for a  (",")    ,   starting at the ( Last character ) which BTW. is the default
130    'Whole Number Part
140    Dim strHlNumber As String: Let strHlNumber = VBA.Strings.Left$(strNumber, (posDecSep - 1))
150     Let strHlNumber = Replace(strHlNumber, ",", Empty, 1, -1) 'In (strHlNumber)   ,   I look for a (",")   ,    and replace it with "VBA Nothing there"    ,     considering and returning the strNumber from  the start of the string    ,     and replace all occurances ( -1 ).
160    Dim HlNumber As Long: Let HlNumber = CLng(strHlNumber) 'Long Number is a Whole Number, no fractional Part
170    'Fraction Part of Number
180    Dim strFrction As String: Let strFrction = VBA.Strings.Mid$(strNumber, (posDecSep + 1), (LenstrNumber - posDecSep)) 'Part of string (strNumber )  ,  starting from just after Decimal separator  ,    and extending to a length of = ( the length  of the whole strNumber minus  the position of the separator )
190    Dim LenstrFrction As Long: Let LenstrFrction = Len(strFrction) 'Digits after Seperator. This must be done at the String Stage, as length of Long, Double etc will allways be 8, I think?.
200    Dim Frction As Double: Let Frction = CDbl(strFrction) 'This will convert to a Whole Double Number. Double Number can have  Fractional part
210     Let Frction = Frction * 1 / (10 ^ (LenstrFrction)) 'Use 1/___, rather than a x 0.1 or 0,1 so as not to add another , . uncertainty!!
220    'Re join, using Maths to hopefully get correct Final Value
230    Dim DblReturn As Double 'Double Number to be returned in required Format after maniplulation.
240         If Left(strHlNumber, 1) <> "-" Then 'Case positive number
250          Let DblReturn = CDbl(HlNumber) + Frction 'Hopefully a simple Mathematics + will give the correct Double Number back
260         Else 'Case -ve Number
270          Let strHlNumber = Replace(strHlNumber, "-", "", 1, 1, vbBinaryCompare) ' strHlNumber * (-1) ' "Remove" -ve sign
280          Let DblReturn = (-1) * (CDbl(strHlNumber) + Frction) 'having constructed the value of the final Number we multiply by -1 to put the Minus sign back
290         End If 'End checking polarity.
300    'Final Code Line(s)   At this point we have what we want. We need to place this in the "Double Type variable" , CStrSepDbl , so that an assinment like    = CStrSepDbl( ) will return this final value
310     Let CStrSepDbl = DblReturn 'Final Double value to be returned by Function
320    Else 'End MAIN CODE. === We came here if we have a Whole Number with no seperator, case no seperator
330    'Simple conversion of a string "Number" with no Decimal Seperator to Double Format
340     Let CStrSepDbl = CDbl(strNumber) 'String to be returned by Function is here just a simple convert to Double ' I guess this will convert a zero length string "" to 0 also
350    End If 'End checking for if a Seperator is present.
End Function
























'Long code lines:  Referrences    http://www.mrexcel.com/forum/about-board/830361-board-wish-list-2.html          http://www.mrexcel.com/forum/test-here/928092-http://www.eileenslounge.com/viewtopic.php?f=27&t=22850
Function CStrSepDblshg(strNumber As String) As Double '          http://excelxor.com/2014/09/05/index-returning-an-array-of-values/      http://www.techonthenet.com/excel/formulas/split.php
5      If Left(strNumber, 1) = "," Or Left(strNumber, 1) = "." Then Let strNumber = "0" & strNumber
20   Let strNumber = Replace(strNumber, ".", ",", 1, -1)
40     If InStr(1, strNumber, ",") > 0 Then
170         If Left(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1), 1) <> "-" Then
180          Let CStrSepDblshg = CDbl(CLng(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1))) + CDbl(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))) * 1 / (10 ^ (Len(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber)))))))
190         Else
210          Let CStrSepDblshg = (-1) * (CDbl(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1) * (-1)) + CDbl(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))) * 1 / (10 ^ (Len(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))))))
220         End If
250    Else
270     Let CStrSepDblshg = CDbl(strNumber)
280    End If
End Function

Demo Code to call Function

Sub TestieCStrSepDbl() ' using adeptly named  TabulatorSyncranartor ' / Introducing LSet TabulatorSyncranartor Statement :   http://www.excelfox.com/forum/showthread.php/2230-Built-in-VBA-methods-and-functions-to-alter-the-contents-of-existing-character-strings
Dim LooksLikeANumber(1 To 17) As String
 Let LooksLikeANumber(1) = "001,456"
 Let LooksLikeANumber(2) = "1.0007"
 Let LooksLikeANumber(3) = "123,456.2"
 Let LooksLikeANumber(4) = "0023.345,0"
 Let LooksLikeANumber(5) = "-0023.345,0"
 Let LooksLikeANumber(6) = "1.007"
 Let LooksLikeANumber(7) = "1.3456"
 Let LooksLikeANumber(8) = "1,2345"
 Let LooksLikeANumber(9) = "01,0700000"
 Let LooksLikeANumber(10) = "1.3456"
 Let LooksLikeANumber(11) = "1,2345"
 Let LooksLikeANumber(12) = ".2345"
 Let LooksLikeANumber(13) = ",4567"
 Let LooksLikeANumber(14) = "-,340"
 Let LooksLikeANumber(15) = "00.04"
 Let LooksLikeANumber(16) = "-0,56000000"
 Let LooksLikeANumber(17) = "-,56000001"
Dim Stear As Variant, MyStringsOut As String
    For Each Stear In LooksLikeANumber()
    Dim Retn As Double
     Let Retn = CStrSepDbl(Stear)
    Dim TabulatorSyncranartor As String: Let TabulatorSyncranartor = "                         "
     LSet TabulatorSyncranartor = Stear
     Let MyStringsOut = MyStringsOut & TabulatorSyncranartor & Retn & vbCrLf
     Debug.Print Stear; Tab(15); Retn
    Next Stear
 MsgBox MyStringsOut
End Sub

Code also Here:
https://pastebin.com/1kq6h9Bn

[DocAElstein]

Code for this Thread:
http://www.excelfox.com/forum/showth...0503#post10503
http://www.excelfox.com/forum/forumd...ips-and-Tricks


Function CStrSepDbl

'10   '   http://www.eileenslounge.com/viewtopic.php?f=27&t=22850#p208624
Function CStrSepDbl(Optional ByVal strNumber As String) As Double '    Return a Double based on a String Input which is asssumed to "Look" like a Number. The code will work for Leading and Trailing zeros, but will not return them. )
20   Rem 0        At the Dim stage  a  '_-String  is "Pointer" to a "Blue Print" (or Form, Questionaire not yet filled in, a template etc.)"Pigeon Hole" in Memory, 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. A String is a bit tricky. The Blue Print code line Paper in the Pigeon Hole will allow to note the string Length and an Initial start memory Location. This Location well have to change frequently as strings of different length are assigned. Instructiions will tell how to do this. Theoretically a specilal value vbNullString is set to aid in quich checks, But http://www.mrexcel.com/forum/excel-questions/361246-vbnullstring-2.html#post44116
30     If StrPtr(strNumber) = 0 Then Let CStrSepDbl = "9999999999": Exit Function '_- StrPtr(MyVaraibleNotYetUsed)=0 ..  http://www.excelfox.com/forum/showthread.php/1828-How-To-React-To-The-Cancel-Button-in-a-VB-(not-Application)-InputBox?p=10463#post10463       https://www.mrexcel.com/forum/excel-questions/35206-test-inputbox-cancel-2.html?highlight=strptr#post2845398    https://www.mrexcel.com/forum/excel-questions/917689-passing-array-class-byval-byref.html#post4412382
40   Rem 1  'Adding a leading zero if no number before a comma or point, change all seperators to comma  ,
50     If VBA.Strings.Left$(strNumber, 1) = "," Or VBA.Strings.Left$(strNumber, 1) = "." Then Let strNumber = "0" & strNumber  ' case for like .12  or ,7   etc 'VBA Strings collection Left function returns a Variant- initially tries to coerces the first parameter into Variant, Left$ does not, that's why Left$ is preferable over Left, it's theoretically slightly more efficient, as it avoids the overhead/inefficieny associated with the Variant. It allows a Null to be returned if a Null is given. https://www.excelforum.com/excel-new...ml#post4084816 .. it is all to do with ya .."Null propagation".. maties ;) '_-.. http://allenbrowne.com/casu-12.html Null is a special "I do not know, / answer unknown" - handy to hav... propogetion wonks - math things like = 1+2+Null returns you null. Or string manipulation stuff like, left(Null returns you Null. Count things like Cnt (x,y,Null) will return 2 - there are two known things there..Hmm -bit iffy although you could argue that Null has not been entered yet..may never
60     If VBA.Strings.Left$(strNumber, 2) = "-," Or VBA.Strings.Left$(strNumber, 2) = "-." Then Let strNumber = Application.WorksheetFunction.Replace(strNumber, 1, 1, "-0") ' case for like  -.12  or -,274   etc
70    Let strNumber = Replace(strNumber, ".", ",", 1, -1, vbBinaryCompare) 'Replace at start any . to a ,  After this point there should be either no or any amount of ,
80     'Check If a Seperator is present, then MAIN CODE is done
90     If InStr(1, strNumber, ",") > 0 Then 'Check we have at least one seperator, case we have, then..
100  Rem 2 'MAIN CODE part ====
110    'Length of String:  Position of last ( Decimal ) Seperator
120    Dim LenstrNumber As Long: Let LenstrNumber = Len(strNumber): Dim posDecSep As Long: Let posDecSep = VBA.Strings.InStrRev(strNumber, ",", LenstrNumber) '  from right the positom "along" from left  (   (in strNumber)  ,  for a  (",")    ,   starting at the ( Last character ) which BTW. is the default
130    'Whole Number Part
140    Dim strHlNumber As String: Let strHlNumber = VBA.Strings.Left$(strNumber, (posDecSep - 1))
150     Let strHlNumber = Replace(strHlNumber, ",", Empty, 1, -1) 'In (strHlNumber)   ,   I look for a (",")   ,    and replace it with "VBA Nothing there"    ,     considering and returning the strNumber from  the start of the string    ,     and replace all occurances ( -1 ).
160    Dim HlNumber As Long: Let HlNumber = CLng(strHlNumber) 'Long Number is a Whole Number, no fractional Part
170    'Fraction Part of Number
180    Dim strFrction As String: Let strFrction = VBA.Strings.Mid$(strNumber, (posDecSep + 1), (LenstrNumber - posDecSep)) 'Part of string (strNumber )  ,  starting from just after Decimal separator  ,    and extending to a length of = ( the length  of the whole strNumber minus  the position of the separator )
190    Dim LenstrFrction As Long: Let LenstrFrction = Len(strFrction) 'Digits after Seperator. This must be done at the String Stage, as length of Long, Double etc will allways be 8, I think?.
200    Dim Frction As Double: Let Frction = CDbl(strFrction) 'This will convert to a Whole Double Number. Double Number can have  Fractional part
210     Let Frction = Frction * 1 / (10 ^ (LenstrFrction)) 'Use 1/___, rather than a x 0.1 or 0,1 so as not to add another , . uncertainty!!
220    'Re join, using Maths to hopefully get correct Final Value
230    Dim DblReturn As Double 'Double Number to be returned in required Format after maniplulation.
240         If Left(strHlNumber, 1) <> "-" Then 'Case positive number
250          Let DblReturn = CDbl(HlNumber) + Frction 'Hopefully a simple Mathematics + will give the correct Double Number back
260         Else 'Case -ve Number
270          Let strHlNumber = Replace(strHlNumber, "-", "", 1, 1, vbBinaryCompare) ' strHlNumber * (-1) ' "Remove" -ve sign
280          Let DblReturn = (-1) * (CDbl(strHlNumber) + Frction) 'having constructed the value of the final Number we multiply by -1 to put the Minus sign back
290         End If 'End checking polarity.
300    'Final Code Line(s)   At this point we have what we want. We need to place this in the "Double Type variable" , CStrSepDbl , so that an assinment like    = CStrSepDbl( ) will return this final value
310     Let CStrSepDbl = DblReturn 'Final Double value to be returned by Function
320    Else 'End MAIN CODE. === We came here if we have a Whole Number with no seperator, case no seperator
330    'Simple conversion of a string "Number" with no Decimal Seperator to Double Format
340     Let CStrSepDbl = CDbl(strNumber) 'String to be returned by Function is here just a simple convert to Double ' I guess this will convert a zero length string "" to 0 also
350    End If 'End checking for if a Seperator is present.
End Function
























'Long code lines:  Referrences    http://www.mrexcel.com/forum/about-board/830361-board-wish-list-2.html          http://www.mrexcel.com/forum/test-here/928092-http://www.eileenslounge.com/viewtopic.php?f=27&t=22850
Function CStrSepDblshg(strNumber As String) As Double '          http://excelxor.com/2014/09/05/index-returning-an-array-of-values/      http://www.techonthenet.com/excel/formulas/split.php
5      If Left(strNumber, 1) = "," Or Left(strNumber, 1) = "." Then Let strNumber = "0" & strNumber
20   Let strNumber = Replace(strNumber, ".", ",", 1, -1)
40     If InStr(1, strNumber, ",") > 0 Then
170         If Left(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1), 1) <> "-" Then
180          Let CStrSepDblshg = CDbl(CLng(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1))) + CDbl(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))) * 1 / (10 ^ (Len(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber)))))))
190         Else
210          Let CStrSepDblshg = (-1) * (CDbl(Replace(Left(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) - 1)), ",", Empty, 1, 1) * (-1)) + CDbl(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))) * 1 / (10 ^ (Len(Mid(strNumber, (InStrRev(strNumber, ",", Len(strNumber)) + 1), (Len(strNumber) - InStrRev(strNumber, ",", Len(strNumber))))))))
220         End If
250    Else
270     Let CStrSepDblshg = CDbl(strNumber)
280    End If
End Function

Demo Code to call Function

Sub TestieCStrSepDbl() ' using adeptly named  TabulatorSyncranartor ' / Introducing LSet TabulatorSyncranartor Statement :   http://www.excelfox.com/forum/showthread.php/2230-Built-in-VBA-methods-and-functions-to-alter-the-contents-of-existing-character-strings
Dim LooksLikeANumber(1 To 17) As String
 Let LooksLikeANumber(1) = "001,456"
 Let LooksLikeANumber(2) = "1.0007"
 Let LooksLikeANumber(3) = "123,456.2"
 Let LooksLikeANumber(4) = "0023.345,0"
 Let LooksLikeANumber(5) = "-0023.345,0"
 Let LooksLikeANumber(6) = "1.007"
 Let LooksLikeANumber(7) = "1.3456"
 Let LooksLikeANumber(8) = "1,2345"
 Let LooksLikeANumber(9) = "01,0700000"
 Let LooksLikeANumber(10) = "1.3456"
 Let LooksLikeANumber(11) = "1,2345"
 Let LooksLikeANumber(12) = ".2345"
 Let LooksLikeANumber(13) = ",4567"
 Let LooksLikeANumber(14) = "-,340"
 Let LooksLikeANumber(15) = "00.04"
 Let LooksLikeANumber(16) = "-0,56000000"
 Let LooksLikeANumber(17) = "-,56000001"
Dim Stear As Variant, MyStringsOut As String
    For Each Stear In LooksLikeANumber()
    Dim Retn As Double
     Let Retn = CStrSepDbl(Stear)
    Dim TabulatorSyncranartor As String: Let TabulatorSyncranartor = "                         "
     LSet TabulatorSyncranartor = Stear
     Let MyStringsOut = MyStringsOut & TabulatorSyncranartor & Retn & vbCrLf
     Debug.Print Stear; Tab(15); Retn
    Next Stear
 MsgBox MyStringsOut
End Sub

Code also Here:
https://pastebin.com/1kq6h9Bn

[DocAElstein]

Further notes in support of answer to this Thread:
http://www.excelfox.com/forum/showth...kbooks-at-once
http://www.excelfox.com/forum/showth...0518#post10518

Microsoft Outlook.
WTF is that and HTF do you do anything with it, and WTF is it supposed to do.

I didn't know. And still don't......
The internet is full of stuff on this, but there is no clear explanation of what it is or what it should do or how you do anything with it.

But I had a go
Microsoft Outlook: what is that ( using manually )
You would normally get the software to run on its own ( visible as it were ) in a similar way to which you might get Word or Excel to start, for example
Find it single click on it:
FindOutlook Start AllProgrammes Microsoft MicrosoftOutlook.JPG : https://imgur.com/LaGs6HA
FindOutlook Start TypeInSearchBox Outlook.JPG : https://imgur.com/IbFOSHz
Make a Desktop icon from a Copy/ paste and double click on it :
MicrosoftOutlook Make a desktop Icon to double click on.JPG : https://imgur.com/ZNNPmOI
The first time you try to open it with a click or two, a set up starts.
Outlook2003Start.JPG https://imgur.com/tSQDoTe
The main use of the Outlook software is to do Email stuff, so usually you will have at least one Email account “registered in it” You can do this at the set up or later.
I had a go,
the start was OK:
Outlook2003Start.JPG https://imgur.com/R71pKfy
Outlook2003Start2.JPG https://imgur.com/XUFMpEm
These following steps took me a few hours of Emails, Internet surfing and annoying Telephone calls to my Internet provider before I
_ chose IMAP here : Outlook2003Start3ServerType.JPG : https://imgur.com/Jmnd6Vb
and
_ got the two required things to put in the 2 server information bars, and other stuff to fill in this : Outlook2003Start4ServerConfiguration.JPG : https://imgur.com/NXNAt9J

Von: "Doc.AElstein@t-online.de" 
An: "elston, alan" 
Pop3
*	Serveradresse	Port*	Sicherheit
Posteingang	securepop.t-online.de	995	SSL / TLS
Postausgang	securesmtp.t-online.de	465	SSL
*
E-Mails über IMAP4 abrufen
*	Serveradresse	Port*	Sicherheit
Posteingang	secureimap.t-online.de	993	SSL
Postausgang	securesmtp.t-online.de	465	SSL

From: "Doc.AElstein@t-online.de" 
To: "elston, alan" 
pop3
Server address Port Security
Inbox securepop.t-online.de 995 SSL / TLS
Outbox securesmtp.t-online.de 465 SSL

Retrieve emails via IMAP4
Server address Port Security
Inbox secureimap.t-online.de 993 SSL
Outbox securesmtp.t-online.de 465 SSL

Outlook2003Start4ServerConfiguration.JPG : https://imgur.com/NXNAt9J
MyTelekomNameUsernamePassword.JPG : https://imgur.com/K6qZgsE
TelekomInternetConfiguration.JPG : https://imgur.com/Z3XcsJu



Then I hit Finish:
Outlook2003Start5Fertig.JPG : https://imgur.com/wIMvqBb ´
I get an error in the left Pane atz that point or later as well sometimes :
Outlook2003Start6LeftpaneErrror.JPG : https://imgur.com/35XLQv6

could not connect to the server  secureimap t online.JPG : https://imgur.com/UqEZtQe 
Fehler (0x800CCC0E) beim Ausführen der Aufgabe "Suchen nach neuen Nachrichten in den abonnierten Ordnern auf secureimap.t-online.de.": "Der Download des Ordners "(null)" von Konto "secureimap.t-online.de" vom IMAP-Mailserver ist fehlgeschlagen. Fehler: Die Verbindung zum Server konnte nicht hergestellt werden. Falls dieser Fehler weiterhin auftritt, wenden Sie sich an den Serveradministrator oder den Internetdienstanbieter."

Fehler (0x800CCC0E) beim Ausführen der Aufgabe "secureimap.t-online.de: Posteingang - Auf neue E-Mail überprüfen.": "Der Download des Ordners "Posteingang" von Konto "secureimap.t-online.de" vom IMAP-Mailserver ist fehlgeschlagen. Fehler: Die Verbindung zum Server konnte nicht hergestellt werden. Falls dieser Fehler weiterhin auftritt, wenden Sie sich an den Serveradministrator oder den Internetdienstanbieter."





Error (0x800CCC0E) while performing the task "Search for new messages in the subscribed folders on secureimap.t-online.de.": "Downloading the folder" (null) "from account" secureimap.t-online.de "from IMAP mail server failed Error: Unable to connect to server If this error persists, contact your server administrator or ISP. "

Error (0x800CCC0E) when executing the task "secureimap.t-online.de: Inbox - Check for new e-mail.": "The download of the folder" Inbox "of account" secureimap.t-online.de "from IMAP- Mail server failed Error: Unable to connect to server If this error persists, contact your server administrator or ISP. "

Every time I open Microsoft Outlook after that I get a pop up : could not connect to the server secureimap t online.JPG : https://imgur.com/UqEZtQe

Es Konnte keine Verbindung zum Server hergestellt werden. secureimap.t-online.de befindet sich jetzt im Offlinemodus

It could not connect to the server. secureimap.t-online.de is now in offline mode

So I am still none the wiser, but It is worth doing all that anyway as you may need some of that information later in one or more of the ways to send an Email using VBA.

[DocAElstein]

Further notes in support of answer to this Thread:
http://www.excelfox.com/forum/showth...kbooks-at-once
http://www.excelfox.com/forum/showth...0518#post10518

Microsoft Outlook.
WTF is that and HTF do you do anything with it, and WTF is it supposed to do.

I didn't know. And still don't......
The internet is full of stuff on this, but there is no clear explanation of what it is or what it should do or how you do anything with it.

But I had a go
Microsoft Outlook: what is that ( using manually )
You would normally get the software to run on its own ( visible as it were ) in a similar way to which you might get Word or Excel to start, for example
Find it single click on it:
FindOutlook Start AllProgrammes Microsoft MicrosoftOutlook.JPG : https://imgur.com/LaGs6HA
FindOutlook Start TypeInSearchBox Outlook.JPG : https://imgur.com/IbFOSHz
Make a Desktop icon from a Copy/ paste and double click on it :
MicrosoftOutlook Make a desktop Icon to double click on.JPG : https://imgur.com/ZNNPmOI
The first time you try to open it with a click or two, a set up starts.
Outlook2003Start.JPG https://imgur.com/tSQDoTe
The main use of the Outlook software is to do Email stuff, so usually you will have at least one Email account “registered in it” You can do this at the set up or later.
I had a go,
the start was OK:
Outlook2003Start.JPG https://imgur.com/R71pKfy
Outlook2003Start2.JPG https://imgur.com/XUFMpEm
These following steps took me a few hours of Emails, Internet surfing and annoying Telephone calls to my Internet provider before I
_ chose IMAP here : Outlook2003Start3ServerType.JPG : https://imgur.com/Jmnd6Vb
and
_ got the two required things to put in the 2 server information bars, and other stuff to fill in this : Outlook2003Start4ServerConfiguration.JPG : https://imgur.com/NXNAt9J

Von: "Doc.AElstein@t-online.de" 
An: "elston, alan" 
Pop3
*	Serveradresse	Port*	Sicherheit
Posteingang	securepop.t-online.de	995	SSL / TLS
Postausgang	securesmtp.t-online.de	465	SSL
*
E-Mails über IMAP4 abrufen
*	Serveradresse	Port*	Sicherheit
Posteingang	secureimap.t-online.de	993	SSL
Postausgang	securesmtp.t-online.de	465	SSL

From: "Doc.AElstein@t-online.de" 
To: "elston, alan" 
pop3
Server address Port Security
Inbox securepop.t-online.de 995 SSL / TLS
Outbox securesmtp.t-online.de 465 SSL

Retrieve emails via IMAP4
Server address Port Security
Inbox secureimap.t-online.de 993 SSL
Outbox securesmtp.t-online.de 465 SSL

Outlook2003Start4ServerConfiguration.JPG : https://imgur.com/NXNAt9J
MyTelekomNameUsernamePassword.JPG : https://imgur.com/K6qZgsE
TelekomInternetConfiguration.JPG : https://imgur.com/Z3XcsJu



Then I hit Finish:
Outlook2003Start5Fertig.JPG : https://imgur.com/wIMvqBb ´
I get an error in the left Pane atz that point or later as well sometimes :
Outlook2003Start6LeftpaneErrror.JPG : https://imgur.com/35XLQv6

could not connect to the server  secureimap t online.JPG : https://imgur.com/UqEZtQe 
Fehler (0x800CCC0E) beim Ausführen der Aufgabe "Suchen nach neuen Nachrichten in den abonnierten Ordnern auf secureimap.t-online.de.": "Der Download des Ordners "(null)" von Konto "secureimap.t-online.de" vom IMAP-Mailserver ist fehlgeschlagen. Fehler: Die Verbindung zum Server konnte nicht hergestellt werden. Falls dieser Fehler weiterhin auftritt, wenden Sie sich an den Serveradministrator oder den Internetdienstanbieter."

Fehler (0x800CCC0E) beim Ausführen der Aufgabe "secureimap.t-online.de: Posteingang - Auf neue E-Mail überprüfen.": "Der Download des Ordners "Posteingang" von Konto "secureimap.t-online.de" vom IMAP-Mailserver ist fehlgeschlagen. Fehler: Die Verbindung zum Server konnte nicht hergestellt werden. Falls dieser Fehler weiterhin auftritt, wenden Sie sich an den Serveradministrator oder den Internetdienstanbieter."





Error (0x800CCC0E) while performing the task "Search for new messages in the subscribed folders on secureimap.t-online.de.": "Downloading the folder" (null) "from account" secureimap.t-online.de "from IMAP mail server failed Error: Unable to connect to server If this error persists, contact your server administrator or ISP. "

Error (0x800CCC0E) when executing the task "secureimap.t-online.de: Inbox - Check for new e-mail.": "The download of the folder" Inbox "of account" secureimap.t-online.de "from IMAP- Mail server failed Error: Unable to connect to server If this error persists, contact your server administrator or ISP. "

Every time I open Microsoft Outlook after that I get a pop up : could not connect to the server secureimap t online.JPG : https://imgur.com/UqEZtQe

Es Konnte keine Verbindung zum Server hergestellt werden. secureimap.t-online.de befindet sich jetzt im Offlinemodus

It could not connect to the server. secureimap.t-online.de is now in offline mode

So I am still none the wiser, but It is worth doing all that anyway as you may need some of that information later in one or more of the ways to send an Email using VBA.

[DocAElstein]

_1 ) Way 1) Use the CDO (Collaboration Data Objects ) object library available in VBA
Main Code , Sub PetrasDailyProWay1_COM_Way() ,
and
Function Code for solution to this Thread and Post
http://www.excelfox.com/forum/showth...kbooks-at-once
http://www.excelfox.com/forum/showth...0518#post10518

Option Explicit ' Daily Diet plan, Sending of Notes and an Excel File
Sub PetrasDailyProWay1_COM_Way() '  Allow access to deep down cods wollops from Microsoft to collaborating in particular in the form of messaging. An available library of ddl library functions and associated things is available on request, the  Microsoft CDO for Windows 2000. We require some of these '  CDO is an object library that exposes the interfaces of the Messaging Application Programming Interface (MAPI). API: interfaces that are fairly easy to use from a fairly higher level from within a higher level programming language. In other words this allows you to get at and use some of the stuff to do with the COM OLE Bollocks from within a programming language such as VBA  API is often referring loosely to do with using certain shipped with Windows software in Folders often having the extension dll. This extension , or rather the dll stands for direct link libraries. These are special sort of executable files of functions shared by many other (Windows based usually) software’s.
' Rem1 The deep down fundamental stuff , which includes stuff been there the longest goes by the name of Component Object Model. Stuff which is often, but not always, later stuff, or at a slightly higher level of the computer workings, or slightly more to a specific application ( an actual running "runtime" usage / at an instance in time , "instance of" ) orientated goes to the name of Object Linking and Embedding. At this lower level, there are protocols for communicating between things, and things relate are grouped into the  to Office  application available Library, CDO. An important object there goes by the name of Message.
'Rem 1) Library made available            ====================#
  With CreateObject("CDO.Message") '   Folders mostly but not always are in some way referenced using dll, either as noted with the extension or maybe refered to as dll Files or dll API files.
'Rem 2 ' Intraction protocols are given requird infomation and then set
    '2a) 'With --------------------* my Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups) which are used and items configured for the Exchange at Microsoft’s protocol thereof;   http://schemas.microsoft.com/cdo/configuration/ ......This section provides the configuration information for the remote SMTP server
    Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" ' Linking Configuration Data : defines the majority of fields used to set configurations for various Linking Collaboration (LCD) Objects Cods Wollops: These configuration fields are set using an implementation of the IConfiguration.Fields collection.  https://msdn.microsoft.com/en-us/library/ms872853(v=exchg.65).aspx
     .Configuration(LCD_CW & "smtpusessl") = True ' ' ' HTTPS (Hyper Text Transfer Protocol Secure) appears in the URL when a website is secured by an SSL certificate. The details of the certificate, including the issuing authority and the corporate name of the website owner, can be viewed by clicking on the lock symbol on the browser bar. in short, it's the standard technology for keeping an internet connection secure and safeguarding any sensitive data that is being sent between two systems, preventing criminals from reading and modifying any information transferred, including potential personal details.  ' SSL protocol has always been used to encrypt and secure transmitted data
     .Configuration(LCD_CW & "smtpauthenticate") = 1  ' ... possibly this also needed ..   When you also get the Authentication Required Error you can add this three lines.
    '  ' Sever info
     .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "securesmtp.t-online.de"                 '"smtp.gmail.com" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com"  "smtp-mail.outlook.com" "smtp.live.com"  "securesmtp.t-online.de"  465         SMTP is just used to mean the common stuff.....  Simple Mail Transport Protocol (SMTP) server is used to send outgoing e-mails. The SMTP server receives emails from your Mail program and sends them over the Internet to their destination.
    '  The mechanism to use to send messages.
     .Configuration(LCD_CW & "sendusing") = 2  '  Based on the LCD_OLE Data Base of type DBTYPE_I4
     .Configuration(LCD_CW & "smtpserverport") = 25 ' 465or25fort-online ' 465 'or 587 'or 25   ' The port of type somehow refered to by the last line
    '
     .Configuration(LCD_CW & "sendusername") = "excelvbaexp@gmail.com" ' "Doc.AElstein@t-online.de" ' .... "server rejected your response".  AFAIK : This will happen if you haven't setup an account in Outlook Express or Windows Mail .... Runtime error '-2147220975 (800440211)': The message could not be sent to the SMTP server. The transport error code is 0x80040217. The server response is not available
     .Configuration(LCD_CW & "sendpassword") = "Bollocks" '              "Bollox"
    ' Optional - How long to try     ( End remote SMTP server configuration section )
     .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 '    Or there Abouts ;) :)
    ' Intraction protocol is Set/ Updated
     .Configuration.Fields.Update ' 'Not all infomation is given, some will have defaults. - possibly this might be needed initially ..    .Configuration.Load -1 ' CDO Source Defaults
    'End With ' -------------------* my Created  LCDCW Library ( Linking Configuration Data Cods Wollups)  which are  used and items configured for the Exchange at Microsoft's protocol therof;
   '2b) ' Data to be sent
   '.To = "Doc.AElstein@t-online.de"
   .To = "excelvbaexp@gmail.com"
   .CC = ""
   .BCC = ""
   .from = """Alan"" "
   .Subject = "Bollox"
   '.TextBody = "Hi" & vbNewLine & vbNewLine & "Please find the Excel workbook attached."
   .HTMLBody = MyLengthyStreaming
   .AddAttachment "G:\ALERMK2014Marz2016\NeueBlancoAb27.01.2014\AbJan2016\Übersicht aktuell.xlsx" ' ' Full File path and name. File must be closed
 Rem 3 Do it
   .Send
 End With ' CreateObject("CDO.Message") (Rem 1 Library End =======#
End Sub
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\ProMessage.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
Rem 2 possible additions to MyLengthyStreaming

Last bit of Function ( must go here in the excelfox Test Sub Forum in HTML Tags as there are HTML Tags in the final text string string and this makes a mess in normal BB code tags, because in excelfox Test Forum HTML is activated ) :

Rem 2
 Let MyLengthyStreaming = "<p><span style=""color: #ff00ff;"">Start=========== " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ------------------------------------</span></p>" & MyLengthyStreaming & "<p><span style=""color: #ff00ff;"">-- " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ==End, Sent from Doc.AElstein Mail ======</span></p>"
End Function

[DocAElstein]

_1 ) Way 1) Use the CDO (Collaboration Data Objects ) object library available in VBA
Main Code , Sub PetrasDailyProWay1_COM_Way() ,
and
Function Code for solution to this Thread and Post
http://www.excelfox.com/forum/showth...kbooks-at-once
http://www.excelfox.com/forum/showth...0518#post10518

Option Explicit ' Daily Diet plan, Sending of Notes and an Excel File
Sub PetrasDailyProWay1_COM_Way() '  Allow access to deep down cods wollops from Microsoft to collaborating in particular in the form of messaging. An available library of ddl library functions and associated things is available on request, the  Microsoft CDO for Windows 2000. We require some of these '  CDO is an object library that exposes the interfaces of the Messaging Application Programming Interface (MAPI). API: interfaces that are fairly easy to use from a fairly higher level from within a higher level programming language. In other words this allows you to get at and use some of the stuff to do with the COM OLE Bollocks from within a programming language such as VBA  API is often referring loosely to do with using certain shipped with Windows software in Folders often having the extension dll. This extension , or rather the dll stands for direct link libraries. These are special sort of executable files of functions shared by many other (Windows based usually) software’s.
' Rem1 The deep down fundamental stuff , which includes stuff been there the longest goes by the name of Component Object Model. Stuff which is often, but not always, later stuff, or at a slightly higher level of the computer workings, or slightly more to a specific application ( an actual running "runtime" usage / at an instance in time , "instance of" ) orientated goes to the name of Object Linking and Embedding. At this lower level, there are protocols for communicating between things, and things relate are grouped into the  to Office  application available Library, CDO. An important object there goes by the name of Message.
'Rem 1) Library made available            ====================#
  With CreateObject("CDO.Message") '   Folders mostly but not always are in some way referenced using dll, either as noted with the extension or maybe refered to as dll Files or dll API files.
'Rem 2 ' Intraction protocols are given requird infomation and then set
    '2a) 'With --------------------* my Created LCDCW Library, (LCD 1.0 Library ) (Linking Configuration Data_Cods Wollups) which are used and items configured for the Exchange at Microsoft’s protocol thereof;   http://schemas.microsoft.com/cdo/configuration/ ......This section provides the configuration information for the remote SMTP server
    Dim LCD_CW As String: Let LCD_CW = "http://schemas.microsoft.com/cdo/configuration/" ' Linking Configuration Data : defines the majority of fields used to set configurations for various Linking Collaboration (LCD) Objects Cods Wollops: These configuration fields are set using an implementation of the IConfiguration.Fields collection.  https://msdn.microsoft.com/en-us/library/ms872853(v=exchg.65).aspx
     .Configuration(LCD_CW & "smtpusessl") = True ' ' ' HTTPS (Hyper Text Transfer Protocol Secure) appears in the URL when a website is secured by an SSL certificate. The details of the certificate, including the issuing authority and the corporate name of the website owner, can be viewed by clicking on the lock symbol on the browser bar. in short, it's the standard technology for keeping an internet connection secure and safeguarding any sensitive data that is being sent between two systems, preventing criminals from reading and modifying any information transferred, including potential personal details.  ' SSL protocol has always been used to encrypt and secure transmitted data
     .Configuration(LCD_CW & "smtpauthenticate") = 1  ' ... possibly this also needed ..   When you also get the Authentication Required Error you can add this three lines.
    '  ' Sever info
     .Configuration(LCD_CW & "smtpserver") = "smtp.gmail.com" ' "securesmtp.t-online.de"                 '"smtp.gmail.com" "smtp.mail.yahoo.com" "smtp.live.com" "pod51017.outlook.com"  "smtp-mail.outlook.com" "smtp.live.com"  "securesmtp.t-online.de"  465         SMTP is just used to mean the common stuff.....  Simple Mail Transport Protocol (SMTP) server is used to send outgoing e-mails. The SMTP server receives emails from your Mail program and sends them over the Internet to their destination.
    '  The mechanism to use to send messages.
     .Configuration(LCD_CW & "sendusing") = 2  '  Based on the LCD_OLE Data Base of type DBTYPE_I4
     .Configuration(LCD_CW & "smtpserverport") = 25 ' 465or25fort-online ' 465 'or 587 'or 25   ' The port of type somehow refered to by the last line
    '
     .Configuration(LCD_CW & "sendusername") = "excelvbaexp@gmail.com" ' "Doc.AElstein@t-online.de" ' .... "server rejected your response".  AFAIK : This will happen if you haven't setup an account in Outlook Express or Windows Mail .... Runtime error '-2147220975 (800440211)': The message could not be sent to the SMTP server. The transport error code is 0x80040217. The server response is not available
     .Configuration(LCD_CW & "sendpassword") = "Bollocks" '              "Bollox"
    ' Optional - How long to try     ( End remote SMTP server configuration section )
     .Configuration(LCD_CW & "smtpconnectiontimeout") = 30 '    Or there Abouts ;) :)
    ' Intraction protocol is Set/ Updated
     .Configuration.Fields.Update ' 'Not all infomation is given, some will have defaults. - possibly this might be needed initially ..    .Configuration.Load -1 ' CDO Source Defaults
    'End With ' -------------------* my Created  LCDCW Library ( Linking Configuration Data Cods Wollups)  which are  used and items configured for the Exchange at Microsoft's protocol therof;
   '2b) ' Data to be sent
   '.To = "Doc.AElstein@t-online.de"
   .To = "excelvbaexp@gmail.com"
   .CC = ""
   .BCC = ""
   .from = """Alan"" "
   .Subject = "Bollox"
   '.TextBody = "Hi" & vbNewLine & vbNewLine & "Please find the Excel workbook attached."
   .HTMLBody = MyLengthyStreaming
   .AddAttachment "G:\ALERMK2014Marz2016\NeueBlancoAb27.01.2014\AbJan2016\Übersicht aktuell.xlsx" ' ' Full File path and name. File must be closed
 Rem 3 Do it
   .Send
 End With ' CreateObject("CDO.Message") (Rem 1 Library End =======#
End Sub
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\ProMessage.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
Rem 2 possible additions to MyLengthyStreaming

Last bit of Function ( must go here in the excelfox Test Sub Forum in HTML Tags as there are HTML Tags in the final text string string and this makes a mess in normal BB code tags, because in excelfox Test Forum HTML is activated ) :

Rem 2
 Let MyLengthyStreaming = "<p><span style=""color: #ff00ff;"">Start=========== " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ------------------------------------</span></p>" & MyLengthyStreaming & "<p><span style=""color: #ff00ff;"">-- " & Format(Now(), "DD MMMM YYYY") & " " & Now() & " ==End, Sent from Doc.AElstein Mail ======</span></p>"
End Function