Page 19 of 19 FirstFirst ... 9171819
Results 181 to 190 of 190

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

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,468
    Rep Power
    10
    Some screen shots for this post https://eileenslounge.com/viewtopic....313792#p313792











    ......Here a slightly simpler demo, just for Eileens Lounge..., but it’s a real example looking at one of the smaller Folders I have been wanting to investigate.
    To do it:
    Put the uploaded file, EileenMMDemo.xls, and this folder ,
    Movie Maker https://app.box.com/s/cxvc735a85q6az2r3gtb7ii9w2p3jzpf
    , in the same place. Then just open the file EileenMMDemo.xls. That file only has one worksheet so the workbook should show just one window of that. In that window make a selection towards the left. Now run the only available macro, Sub PassFolderForReocursing3() , in that workbook which is in the only code module. At the start of the macro it will use the ActiveCell of that window to try and get a single cell range object from the your window Selection . It usually manages that, and goes on to put some results out with that cell at top left. It should look something like this
    Attached Files Attached Files
    Last edited by DocAElstein; 01-27-2024 at 12:50 AM.

  2. #2
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,468
    Rep Power
    10
    Code:
    Private Sub ReoccurringFldItmeFolderProps3(ByVal Pf As String)
    Rem 0
     Let Reocopy = Reocopy + 1 ' Originally the variable  Reocopy  is zero.  It will become 1 on first entering the macro.  Every time we leave this macro, this number is reduced by 1   So in simple use it will be 1 or zero indicating that a copy is in use.  However, should this macro "Call itself", before its finished , ( the recursion idea ) then the value will be 2  and so on.  So effectively it tells us which copy is running at any time
    Rem 1
     'Set objWSO = New Shell32.Shell            '    https://i.postimg.cc/Fz9zrnNm/Tools-Referrences-Microsoft-Shell-Controls-And-Automation.jpg     https://i.postimg.cc/sDC9S54h/Tools-Referrences-Microsoft-Shell-Controls-And-Automation.jpg
     Set objWSO = CreateObject("shell.application")
    'Dim objWSOFolder As Shell32.Folder: Set objWSOFolder = objWSO.Namespace((Pf))  '
    Dim objWSOFolder As Object: Set objWSOFolder = objWSO.Namespace((Pf))  '  (( ))  https://stackoverflow.com/questions/33868233/shell-namespace-not-accepting-string-variable-but-accepting-string-itself/77888851#77888851   https://microsoft.public.access.narkive.com/Jl55mts5/problem-using-shell-namespace-method-in-vba#post5
    Rem 2
    'Dim FldItm As Shell32.FolderItem
    Dim FldItm As Object
        For Each FldItm In objWSOFolder.Items ' ======= Main Loop ==================================================|
        ' Dim Clm As Long: ' Global variable
         Let Clm = Clm + 1
        Dim Rw As Long: Let Rw = Reocopy + 1
             Let MeActiveCell.Offset(Rw, Clm) = objWSOFolder.GetDetailsOf(FldItm, 0)
                If objWSOFolder.GetDetailsOf(FldItm, 2) = "Dateiordner" Then                '   GetDetailsOf(FldItm, 2)   tells me the type of the WSO item
                'Set objFSO = New Scripting.FileSystemObject     ' https://i.postimg.cc/d1GHPGxJ/Microsoft-Scripting-Runtime-Library.jpg
                Set objFSO = CreateObject("Scripting.FileSystemObject")
                'Dim objFSOFolder As Scripting.Folder: Set objFSOFolder = objFSO.GetFolder(Pf & "\" & objWSOFolder.GetDetailsOf(FldItm, 0))
                Dim objFSOFolder As Object: Set objFSOFolder = objFSO.GetFolder(Pf & "\" & objWSOFolder.GetDetailsOf(FldItm, 0))
                 Let MeActiveCell.Offset(Rw + 1, Clm) = objFSOFolder.Size
                Else ' If the item is not a folder, then I assume it will be a file?
                'Dim ObjFSOFile As Scripting.File: Set ObjFSOFile = objFSO.GetFile(Pf & "\" & objWSOFolder.GetDetailsOf(FldItm, 0))
                Dim ObjFSOFile As Object: Set ObjFSOFile = objFSO.GetFile(Pf & "\" & objWSOFolder.GetDetailsOf(FldItm, 0))
                 Let MeActiveCell.Offset(Rw + 1, Clm) = ObjFSOFile.Size
                End If
             Let MeActiveCell.Offset(Rw + 2, Clm) = Format(objWSOFolder.GetDetailsOf(FldItm, 3), "dd,mmm,yy")
             Let MeActiveCell.Offset(Rw + 3, Clm) = Format(objWSOFolder.GetDetailsOf(FldItm, 4), "dd,mmm,yy")
             Let MeActiveCell.Offset(Rw + 4, Clm) = objWSOFolder.GetDetailsOf(FldItm, 166)
            '_________________________________________________________________________________________________
            ' 2b  Here we may pause the macro, whilst another copy of it is started
            If objWSOFolder.GetDetailsOf(FldItm, 2) = "Dateiordner" Then Call ReoccurringFldItmeFolderProps3(Pf & "\" & objWSOFolder.GetDetailsOf(FldItm, 0))
            '_________________________________________________________________________________________________
        '   If we did pause whilst the abobe code line set off another copy, then when that is finished we will come here and resume the paused previous copy
        Next FldItm ' ============================== Main Loop  =================================================|
     
     
     Let Reocopy = Reocopy - 1  ' We are finished at this point with this running copy of the macro. (The next code line ends it). This code line here will reduce the value used to keep track of the  copy number being run
    End Sub
    
    Last edited by DocAElstein; 01-27-2024 at 04:04 AM.

  3. #3
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,468
    Rep Power
    10
    Here is the main recursion / reoccurring macro 3 corrected slightly for to get the Late Binding working correctly

    A couple of things were wrong, or rather one thing wrong, which hid a another problem that should have occurred: I had a few things not declared as objects as they should have been. As I coincidently still had the two library references checked, all still worked, and so did a string variable in this bit Set objWSOFolder = objWSO.Namespace(Pf)
    Taking the references off, revealed the problem. Once that was fixed the other problem cropped up https://stackoverflow.com/questions/...88851#77888851
    https://microsoft.public.access.nark...d-in-vba#post5


    This next coding is OK, I think

    Code:
    Option Explicit
    '  "Global" variables that must be declared here
    Dim Clm As Long, Reocopy As Long ' variable for column number to put file or folder details in, number representing the copy of the second macro running at any time
    '  Variables useful/ efficient to declare here as "Global" variables
    'Dim objWSO As Shell32.Shell                 ' Early Binding          ' Set objShell = New Shell32.Shell             '    https://i.postimg.cc/Fz9zrnNm/Tools-Referrences-Microsoft-Shell-Controls-And-Automation.jpg     https://i.postimg.cc/sDC9S54h/Tools-Referrences-Microsoft-Shell-Controls-And-Automation.jpg
    Dim objWSO As Object                        ' Late Binding
    'Dim objFSO As Scripting.FileSystemObject    ' Early Binding          ' Set objFSO = New Scripting.FileSystemObject  ' https://i.postimg.cc/d1GHPGxJ/Microsoft-Scripting-Runtime-Library.jpg
    Dim objFSO As Object                        ' Late Binding
    Dim MeActiveCell As Range                   ' For convenience all output will be referred to a start point. The user should make a selection in the workbook window that has the worksheet for output showing in it.  We will then be able to get the ramge object into VBA from the  ActiveCell  property of that workbook window
    Sub PassFolderForReocursing3()  '
    Rem 0
     Let Clm = 1: Reocopy = 0                                         ' When this macro starts we have not started any output so our column number for output should not yet have been set, and no copies of the next macro will be running so the variable keeping track of the copy number of that macro should not have a number >= 1
    Rem 1
    Dim Ws As Worksheet: Set Ws = Me                                  ' This is and the next bits are a personal preferrence. I like to fully explicitly tell VBA where things are, and I also have a habit of putting coding intended for a worksheet in that particular worksheets code module. Many people work on whatever worksheet is active, so they may prefer to change this to   Set Ws = Application.ActiveSheet, and use that in the next bit.
    Me.Activate: Set MeActiveCell = Workbooks(Me.Parent.Name).Windows.Item(1).ActiveCell ' https://eileenslounge.com/viewtopic.php?p=313747#p313747
    ' 1b
    Dim Parf As String:  Let Parf = ThisWorkbook.Path                 ' This should be given the path to the folder where the folder of interest is, so theere is a good chance this will need to be changed to suit quit often.
    ' 1c  A short string part of the path put top left, not necerssary but just useful for later referrence to give indication of where the main folder was got from
        If Len(Parf) - Len(Replace(Parf, "\", "", 1, -1, vbBinaryCompare)) >= 2 Then ' For a longer path it may be convenient to shorten the output given to the last bit
         Let MeActiveCell = Mid(Parf, InStrRev(Parf, "\", InStrRev(Parf, "\", -1, vbBinaryCompare) - 1, vbBinaryCompare))
        Else ' For a shorter path we can give the full path
         Let MeActiveCell = Parf
        End If
    Rem 2  Windows Shell object
    ' Set objwso = New Shell32.Shell                            '    https://i.postimg.cc/Fz9zrnNm/Tools-Referrences-Microsoft-Shell-Controls-And-Automation.jpg     https://i.postimg.cc/sDC9S54h/Tools-Referrences-Microsoft-Shell-Controls-And-Automation.jpg
     Set objWSO = CreateObject("shell.application")
    'Dim objWSOFolder As Shell32.Folder: Set objWSOFolder = objWSO.Namespace(Parf)
    Dim objWSOFolder As Object: Set objWSOFolder = objWSO.Namespace(Parf & "")  '   & ""   https://stackoverflow.com/questions/33868233/shell-namespace-not-accepting-string-variable-but-accepting-string-itself/77888851#77888851     https://microsoft.public.access.narkive.com/Jl55mts5/problem-using-shell-namespace-method-in-vba#post5
    
    Rem 3 Movie Maker Folder Property names and Property values.
    'Dim FldItm As Shell32.FolderItem
    Dim FldItm As Object
        For Each FldItm In objWSOFolder.Items  '  We loop through all items to find the Movie Maker folder ' =======
            If FldItm.Name = "Movie Maker" Then
            Dim Rw As Long: Let Rw = 1
            ' Property   Name of file or folder
             Let MeActiveCell.Offset(Rw, 0) = objWSOFolder.GetDetailsOf("Willy", 0)
             Let MeActiveCell.Offset(Rw, Clm) = objWSOFolder.GetDetailsOf(FldItm, 0)       '   Name of folder or file  using the WSO way
            ' Property   File or folder size. I use the FSO for this to get a better precision and also because it seems to be broken for a folder item in WSO
             Let MeActiveCell.Offset(Rw + 1, 0) = objWSOFolder.GetDetailsOf("Wonka", 1)
                If objWSOFolder.GetDetailsOf(FldItm, 2) = "Dateiordner" Then                '   GetDetailsOf(FldItm, 2)   tells me the type of the WSO item
                'Set objFSO = New Scripting.FileSystemObject     ' https://i.postimg.cc/d1GHPGxJ/Microsoft-Scripting-Runtime-Library.jpg
                Set objFSO = CreateObject("Scripting.FileSystemObject")
                'Dim objFSOFolder As Scripting.Folder: Set objFSOFolder = objFSO.GetFolder(ThisWorkbook.Path & "\" & objWSOFolder.GetDetailsOf(FldItm, 0))
                Dim objFSOFolder As Object: Set objFSOFolder = objFSO.GetFolder(ThisWorkbook.Path & "\" & objWSOFolder.GetDetailsOf(FldItm, 0))
                 Let MeActiveCell.Offset(Rw + 1, Clm) = objFSOFolder.Size
                Else ' If the item is not a folder, then I assume it will be a file?
                'Dim ObjFSOFile As Scripting.File: Set ObjFSOFile = objFSO.GetFile(ThisWorkbook.Path & "\" & objWSOFolder.GetDetailsOf(FldItm, 0))
                Dim ObjFSOFile As Object: Set ObjFSOFile = objFSO.GetFile(ThisWorkbook.Path & "\" & objWSOFolder.GetDetailsOf(FldItm, 0))
                 Let MeActiveCell.Offset(Rw + 1, Clm) = ObjFSOFile.Size
                End If
             ' Property   Date Last Modified   Änderungsdatum
              Let MeActiveCell.Offset(Rw + 2, 0) = objWSOFolder.GetDetailsOf(42, 3)
              Let MeActiveCell.Offset(Rw + 2, Clm) = Format(objWSOFolder.GetDetailsOf(FldItm, 3), "dd,mmm,yy")
             ' Property   Date Created         Erstelldatum
              Let MeActiveCell.Offset(Rw + 3, 0) = objWSOFolder.GetDetailsOf(42, 4)
              Let MeActiveCell.Offset(Rw + 3, Clm) = Format(objWSOFolder.GetDetailsOf(FldItm, 4), "dd,mmm,yy")
             ' Property   Version
              Let MeActiveCell.Offset(Rw + 4, Clm) = objWSOFolder.GetDetailsOf(666, 166)
              Let MeActiveCell.Offset(Rw + 4, Clm) = objWSOFolder.GetDetailsOf(FldItm, 166)
             Rem 4
             Let Clm = 0
             MeActiveCell.Offset(0, 2).Select: Set MeActiveCell = Workbooks(Me.Parent.Name).Windows.Item(1).ActiveCell ' https://eileenslounge.com/viewtopic.php?p=313747#p313747
             ' 4b
             Call ReoccurringFldItmeFolderProps3(Parf & "\Movie Maker")
             Exit For ' Once we have passed on the full path of the folder,  Movie Maker  , then we are finished with this macro, so we don't need loop further looking fot the Movie Maker folder
            Else
            End If
        Next FldItm ' ===========================================================================================
    End Sub
    Recursion / Reoccring part in next post
    Last edited by DocAElstein; 01-27-2024 at 01:37 PM.

  4. #4
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,468
    Rep Power
    10
    Later

  5. #5
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,468
    Rep Power
    10
    Some stuff to save for prosperity, related to this main forum post https://eileenslounge.com/viewtopic....315229#p315229
    https://eileenslounge.com/viewtopic....315235#p315235


    Some Microsoft documentation as of March 2024, here: https://learn.microsoft.com/en-us/of...rror-statement ( Just some of the first bits, relevant to the discussion at https://eileenslounge.com/viewtopic.php?f=30&t=40752 )


    On Error statement Article 03/30/2022

    Syntax
    On Error GoTo line
    On Error Resume Next
    On Error GoTo 0


    The On Error statement syntax can have any of the following forms:

    Statement Description
    On Error GoTo line Enables the error-handling routine that starts at line specified in the required line argument.
    The line argument is any line label or line number.
    If a run-time error occurs, control branches to line, making the error handler active.
    The specified line must be in the same procedure as the On Error statement; otherwise, a compile-time error occurs.
    On Error Resume Next Specifies that when a run-time error occurs, control goes to the statement immediately following the statement where the error occurred and execution continues. Use this form rather than On Error GoTo when accessing objects.
    On Error GoTo 0 Disables any enabled error handler in the current procedure.

    Remarks
    If you don't use an On Error statement, any run-time error that occurs is fatal; that is, an error message is displayed and execution stops.

    An "enabled" error handler is one that is turned on by an On Error statement; an "active" error handler is an enabled handler that is in the process of handling an error. If an error occurs while an error handler is active (between the occurrence of the error and a Resume, Exit Sub, Exit Function, or Exit Property statement), the current procedure's error handler can't handle the error. Control returns to the calling procedure.

    If the calling procedure has an enabled error handler, it is activated to handle the error. If the calling procedure's error handler is also active, control passes back through previous calling procedures until an enabled, but inactive, error handler is found. If no inactive, enabled error handler is found, the error is fatal at the point at which it actually occurred.

    Each time the error handler passes control back to a calling procedure, that procedure becomes the current procedure. After an error is handled by an error handler in any procedure, execution resumes in the current procedure at the point designated by the Resume statement. .........
    ........................
    Last edited by DocAElstein; 03-16-2024 at 02:04 PM.

  6. #6
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,468
    Rep Power
    10
    Some extra notes for these main forum posts
    https://www.excelfox.com/forum/showt...ll=1#post24163
    https://www.excelfox.com/forum/showt...age3#post24163
    https://eileenslounge.com/viewtopic....317547#p317547
    https://eileenslounge.com/viewtopic....317533#p317533


    This is the original coding from SamPi , which confused me a bit for a few reasons
    The choice of variable names;
    the use of a .xlam file; ( and
    the Class module is only part of the story
    )


    Class Module:
    Code:
    Option Explicit
     
    Public WithEvents App As Application
     
    Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    Dim s As String
    
    s = Wb.Name
    
    If s = "test.csv" Then MyMacro
    
    End Sub
    
    Sub MyMacro()
    MsgBox "Yes"
    End Sub
    
    ThisWorkbook:
    Code:
    Option Explicit
    
    Dim App             As New App
     
    Private Sub Workbook_Open()
         
       Set App.App = Application
    
    End Sub
    
    Attached Files Attached Files
    Last edited by DocAElstein; 05-22-2024 at 10:07 PM.

  7. #7
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,468
    Rep Power
    10
    Coding and possibly later extra notes for these main forum postings
    https://eileenslounge.com/viewtopic....323547#p323547
    https://www.excelfox.com/forum/showt...ll=1#post17882


    Code:
    Private Function DBugPrntArr(ByVal Arr As Variant) As Variant
    'ReDim DBugPrntArr(LBound(Arr) To UBound(Arr))
    Dim Var As Variant: ReDim Var(LBound(Arr) To UBound(Arr))
    Dim Eye As Long, strOut As String
        For Eye = LBound(Arr) To UBound(Arr)
         Let Var(Eye) = Arr(Eye)
         Let strOut = strOut & Arr(Eye) & ", "
        Next Eye
     Let strOut = "{" & Left(strOut, Len(strOut) - 2) & "}" '    Left(strOut, Len(strOut - 2))  is  Take off last  comma and space
    Debug.Print strOut
    Stop ' Check watch window on var    '  https://i.postimg.cc/fytpYm4V/Byte-Array.jpg
    End Function
    Private Sub StrConvBSTR()  '   https://www.excelfox.com/forum/showthread.php/2824/page2#post17882
    Rem 0
    Dim Bite As Byte: Let Bite = 0: Let Bite = 255 ' : Let Bite = 256     Let Bite = -1  ' Runtime error '6' Overflow
    Dim ByteArr() As Byte
    Dim BSTR As String, VBABString As String '   The Unicode character array that is pointed to by a BSTR must be preceded by a 4-byte length field and terminated by a single null 2-byte character (ANSI = 0)
     Let BSTR = "help": Debug.Print BSTR     ' help
     Let VBABString = BSTR         '   The variable  VBABString  is a pointer   to  the VB  pointer
     Let ByteArr() = BSTR    ' ### '   coerce string to array of bytes      ' 104 0 101 0 108 0 112 0
     ' 0b  https://eileenslounge.com/viewtopic.php?p=323085#p323085    https://eileenslounge.com/viewtopic.php?p=297500#p297500 (Second half)
    ' https://www.excelfox.com/forum/showthread.php/2824/page2#post17880
    Rem 1 … ... Unicode?
    Dim UnicChrArr As String, vTemp As Variant
     Let BSTR = "Alan"
     Let UnicChrArr = StrConv(BSTR, vbUnicode)
     ' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(UnicChrArr) ' "h" & Chr(0) & "e" & Chr(0) & "l" & Chr(0) & "p" & Chr(0)
    
    
    ' 1b
      Let ByteArr() = StrConv(BSTR, vbUnicode)  ' ###                 ' 65 0 0 0 108 0 0 0 97 0 0 0 110 0 0 0
    Call DBugPrntArr(ByteArr()) '  {65, 0, 0, 0, 108, 0, 0, 0, 97, 0, 0, 0, 110, 0, 0, 0}    https://i.postimg.cc/qR2yq8xJ/Byte-Array-Unicode.jpg
    ' Let strArr() = StrConv(BSTR, vbUnicode) ' Type mismatch
      Let vTemp = StrConv(BSTR, vbUnicode)
     ' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(vTemp)      ' "A" & Chr(0) & "l" & Chr(0) & "a" & Chr(0) & "n" & Chr(0)
    ' 1d
     Let ByteArr() = StrConv(StrConv(BSTR, vbFromUnicode), vbUnicode) ' 65 0 108 0 97 0 110 0
     Let vTemp = StrConv(StrConv(BSTR, vbFromUnicode), vbUnicode)     ' "Alan"
    Dim strArr() As String
     Let strArr() = Split(UnicChrArr, vbNullChar)                                        ' "A" "l" "a" "n" ""                                                               https://www.vbforums.com/showthread.php?526299-How-can-you-split-a-string-into-all-its-characters&p=3252316&viewfull=1#post3252316    http://gaffiprog.blogspot.com/2013/04/golfing-tip-vba-split-string-into.html
     Let strArr() = Split(Left(UnicChrArr, Len(UnicChrArr) - 1), vbNullChar) ' "A" "l" "a" "n"
    ' 1e
     Let strArr() = Split(Left(StrConv(BSTR, vbUnicode), Len(StrConv(BSTR, vbUnicode)) - 1), vbNullChar) ' "A" "l" "a" "n"   https://i.postimg.cc/7PQjwS7R/text-to-array.jpg
    
    Rem 2 "Unicode To ANSI"
    Debug.Print StrConv(BSTR, vbFromUnicode) ' ??  ' VB's "No idea how to display these characters as I don't even know what they are" (sometimes you might get a character, if the unicode byte pattern coincidentally matches a character in the current code page)
     Let vTemp = StrConv(BSTR, vbFromUnicode)
    Debug.Print vTemp ' ??                         ' VB's "No idea how ...
    ' Let strArr() = StrConv(s, vbFromUnicode) ' Type mismatch
    Dim varArr() As Variant
    ' Let varArr() = StrConv(s, vbFromUnicode) ' Type mismatch
     Let ByteArr() = StrConv(BSTR, vbFromUnicode)  '  65 108 97 110
    Debug.Print ByteArr()                          ' VB's "No idea how to ...
     Let ByteArr() = StrConv("Alan", vbFromUnicode) ' 65 108 97 110
    Call DBugPrntArr(ByteArr())      ' {65, 108, 97, 110}     '   https://i.postimg.cc/fytpYm4V/Byte-Array.jpg
    ' 2b Looking at a few characters of later interset
     Let BSTR = "help" & ChrW(8230)   '  "help" & "…"           8230      2026  …
     Let ByteArr() = StrConv(BSTR, vbFromUnicode)  ' 104 101 108 112 133        ' https://i.postimg.cc/tTzWvZQN/Character-number-133-across-the-board.jpg
     Let BSTR = "help" & ChrW(133)  '    133 …               …        horizontal ellipsis        …       133      85 …   NEL   Next Line
     Let ByteArr() = StrConv(BSTR, vbFromUnicode)  ' 104 101 108 112 65
     Let BSTR = "help" & Chr(133)  '    133 …               …        horizontal ellipsis        …       133      85 …   NEL   Next Line
     Let ByteArr() = StrConv(BSTR, vbFromUnicode)  ' 104 101 108 112 133
     Let BSTR = "help" & "…"
     Let ByteArr() = StrConv(BSTR, vbFromUnicode)  ' 104 101 108 112 133
     
     Debug.Print AscW(ChrW(8230)) ' 8330                  Wiki says
     Debug.Print Asc(ChrW(133))   '   63     ( 63 is ? )  Wiki says NEL   Next Line
     Debug.Print Asc(Chr(133))    '  133
     Debug.Print Asc("…")         '  133
     Debug.Print AscW("…")        ' 8230
      
     Let BSTR = "help" & ChrW(1000)  '            1000      3E8   ?   ?           Coptic Capital Letter Hori  Greek and Coptic
     Let ByteArr() = StrConv(BSTR, vbFromUnicode)  ' 104 101 108 112 63    63 is ?
    ' 1c That Greek slanted AE which seems to have ChrW(482) and Chr(198)
     Let BSTR = "help" & ChrW(482)  '  (AE thing)   482      1E2    ?   ?        Latin Capital Letter ? with macron  for Sami   Phonetic & historic letters
     Let ByteArr() = StrConv(BSTR, vbFromUnicode)  ' 104 101 108 112 63    63 is ?
    
     Let BSTR = "help" & ChrW(198)  '  (AE thing)  Latin Capital Letter ? with macron  for Sami    also    '    198 Æ               ?        Latin capital letter AE        Asc(left(range("A1").Value,1)) is 65    AscW(left(range("A1").Value,1)) is 198      198 Æ               ?        Latin capital letter AE        ?       198      C6 ?   ?      Latin Capital letter ?   "Letters: Uppercase ""
     Let ByteArr() = StrConv(BSTR, vbFromUnicode)  ' 104 101 108 112 198
    Debug.Print "Æ" & " " & Asc("Æ") & " " & AscW("Æ") '  Æ 198 198
     Let BSTR = "help" & ChrW(65535)  '              65535      FFFF ?
     Let ByteArr() = StrConv(BSTR, vbFromUnicode)  ' 104 101 108 112 63
    
    ' 1d Showing perhaps the ignorance
     Let UnicChrArr = "A" & vbNullChar & "E" & vbNullChar
    Debug.Print UnicChrArr '   A E
    Debug.Print StrConv(UnicChrArr, vbFromUnicode) ' AE
     Let ByteArr() = StrConv(UnicChrArr, vbFromUnicode)
    
    End Sub
    

    Ref
    https://www.eileenslounge.com/viewto...297326#p297326 https://www.eileenslounge.com/viewto...297329#p297329
    https://eileenslounge.com/viewtopic....323085#p323085
    https://www.excelfox.com/forum/showt...age2#post17880
    Last edited by DocAElstein; 12-30-2024 at 04:12 PM.

  8. #8
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,468
    Rep Power
    10
    Coding for these main forum posts
    https://eileenslounge.com/viewtopic....324039#p324039
    https://www.excelfox.com/forum/showt...age2#post11883
    https://eileenslounge.com/viewtopic....324064#p324064

    From Mike(SpeakEasy), here https://eileenslounge.com/viewtopic....324039#p324039
    Code:
     Option Explicit
    
    Private Declare Function StrTrim Lib "shlwapi.dll" Alias "StrTrimA" (ByVal psz As String, ByVal pszTrimChars As String) As Long ' we'll be passing vb string to api
    Private Declare Function StrTrimTrick Lib "shlwapi.dll" Alias "StrTrimA" (ByVal psz As Long, ByVal pszTrimChars As Long) As Long ' we'll be passing the StrPtr to API
    
    Public Sub trimmy()
        Dim a As String
        Dim b As String
        
        a = "Hello" & ChrW(257) ' add a non-extended ASCII (i.e non 'ANSI') unicode character
        b = a
        
        Debug.Print a
        Debug.Print a = b
        Debug.Print AscW(Right(a, 1))
    
        StrTrim a, "" ' call an 'ANSI' API function that does nothing to a string, so we'd expect the same string we passed in ...
        Debug.Print a
        Debug.Print a = b ' Oh
        Debug.Print AscW(Right(a, 1)) ' Oh dear
        
    End Sub
    
    Public Sub trimmy2()
        Dim a As String
        Dim b As String
        
        a = "Hello" & ChrW(257) ' add a non-extended ASCII (i.e non 'ANSI') unicode character
        b = a
        
        Debug.Print a
        Debug.Print a = b
        Debug.Print AscW(Right(a, 1))
    
        StrTrimTrick StrPtr(a), StrPtr("") ' call 'trick' version of 'ANSI' API function that does nothing to a string, so we'd expect the same string we passed in ...
        Debug.Print a
        Debug.Print a = b ' hurrah
        Debug.Print AscW(Right(a, 1)) ' as we'd expect
        
    End Sub
    My versions of those, and a third coding that is almost identical to the second of mine
    Code:
    Option Explicit
    Private Declare Function StrTrim Lib "shlwapi.dll" Alias "StrTrimA" (ByVal psz As String, ByVal pszTrimChars As String) As Long ' we'll be passing vb string to api
    Private Declare Function StrTrimTrick Lib "shlwapi.dll" Alias "StrTrimA" (ByVal psz As Long, ByVal pszTrimChars As Long) As Long ' we'll be passing the StrPtr to API
    Private Declare Function StrTrimTrickW Lib "shlwapi.dll" Alias "StrTrimW" (ByVal psz As Long, ByVal pszTrimChars As Long) As Long ' we'll be passing the StrPtr to API
    '  https://eileenslounge.com/viewtopic.php?p=324039#p324039
    Public Sub JimmyJimmyRiddleA() '  https://www.youtube.com/watch?v=66CCLS0do7c
    Rem 0
    Dim a As String, b As String, Boo As Boolean
     Let a = "Hello" & ChrW(257)   ' add a non-extended ASCII (i.e non 'ANSI') unicode character (a with a small thing on top)
     Let b = a
    Rem 1
    Debug.Print ChrW(257), a: Let Range("A1") = a ' Immediate Window don't do Unicorn , Excel Spreadsheet does
    Debug.Print a = b
    Debug.Print AscW(Right(a, 1)), AscW(Right(Range("A1").Value, 1)), Len(a) '   257     257     6
    Rem 2 ' call an 'ANSI' API function that does nothing to a string, so we'd expect the same string we passed in ...
    Let Boo = StrTrim(a, "") ' Boo is False
    Debug.Print a: Let Range("A1") = a
    Debug.Print a = b ' Oh, it's False
    Debug.Print AscW(Right(a, 1)), Len(a) ' 97     6   Oh dear
        
    End Sub
    Public Sub JimmyJimmyRiddleAW() '  https://www.youtube.com/watch?v=Pgqa3cVOxUc
    Rem 0
    Dim a As String, b As String, Boo As Boolean
     Let a = "Hello" & ChrW(257)    ' add a non-extended ASCII (i.e non 'ANSI') unicode character (a with a small thing on top)
     Let b = a
    Rem 1
    Debug.Print ChrW(257), a: Let Range("A1") = a
    Debug.Print a = b
    Debug.Print AscW(Right(a, 1)) ' True
    Rem 2 '  call ( Implicit W ) 'trick' version of 'ANSI' API function that does nothing to a string, so we'd expect the same string we passed in ...
     Let Boo = StrTrimTrick(StrPtr(a), StrPtr(""))
    Debug.Print a
    Debug.Print a = b ' True,   hurrah
    Debug.Print AscW(Right(a, 1)) ' as we'd expect
    End Sub
    Public Sub JimmyJimmyRiddleW() '  https://www.youtube.com/watch?v=RMEOy-SkX0k
    Rem 0
    Dim a As String, b As String, Boo As Boolean
     Let a = "Hello" & ChrW(257)    ' add a non-extended ASCII (i.e non 'ANSI') unicode character (a with a small thing on top)
     Let b = a
    Rem 1
    Debug.Print ChrW(257), a: Let Range("A1") = a
    Debug.Print a = b
    Debug.Print AscW(Right(a, 1)) ' True
    Rem 2 '  call  Emplicit W  'trick' version of Wide API function that does nothing to a string, so we'd expect the same string we passed in ...
     Let Boo = StrTrimTrickW(StrPtr(a), StrPtr(""))
    Debug.Print a
    Debug.Print a = b ' True,   hurrah
    Debug.Print AscW(Right(a, 1)) ' as we'd expect
    End Sub
    Last edited by DocAElstein; 01-11-2025 at 02:28 PM.

  9. #9
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,468
    Rep Power
    10
    Coding for this Post
    https://www.excelfox.com/forum/showt...ll=1#post24943
    Code:
    Private Declare Function StrTrim Lib "shlwapi.dll" Alias "StrTrimA" (ByVal psz As String, ByVal pszTrimChars As String) As Boolean '  '  Straight AASI          -   we'll be passing vb string to api         ' https://learn.microsoft.com/en-us/windows/win32/api/shlwapi/nf-shlwapi-strtrima
    Private Declare Function StrTrimWU Lib "shlwapi.dll" Alias "StrTrimW" (ByVal psz As Long, ByVal pszTrimChars As Long) As Boolean '  '  Straight AASI          -   we'll be passing vb string to api         ' https://learn.microsoft.com/en-us/windows/win32/api/shlwapi/nf-shlwapi-strtrima
    Sub BSTR_LPWSTR() ' https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-Pasting-API-Cliipboard-issues-and-Rough-notes-on-Advanced-API-stuff?p=24943&viewfull=1#post24943
    Rem 1
    Dim strBSTR As String, strNew As String, Boo As Boolean, pz1PWSTR As Long, pz2PWSTR As Long
    '  "vbNullString  state"
    Debug.Print VarPtr(strBSTR) '        1831480     This could be regarded as getting me the variable, strBSTR. It is the symbol for the pointer stored on the COFF symbol table
    Debug.Print VarPtr(ByVal strBSTR) '      0       Our Pointer is empty at this point
     
    '  "Zero length string state"
     Let strBSTR = ""
    Debug.Print VarPtr(strBSTR)      '   1831480     There is no reason for this to change
    Debug.Print VarPtr(ByVal strBSTR) '  195893860   We now have something significant that we can definitely relate to a string character storage
    '  "A" state
     Let strBSTR = "A"
    Debug.Print VarPtr(strBSTR)      '   1831480     There is no reason for this to change
    Debug.Print VarPtr(ByVal strBSTR) '  195894740   We now have something significant that we can definitely relate to a string character storage
    
    Rem 2  LPWSTR v BSTR
    ' 2a) VBA
     Let strBSTR = "Pog" & Chr(0) & " ": Debug.Print strBSTR & "Z"  '  Pog  Z
    'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strBSTR)             '  "Pog" & Chr(0) & " "
    ' 2b) api  Trim
     Let strNew = strBSTR ' A pointer to the null-terminated string to be trimmed. When this function returns successfully, it receives the trimmed string.
     Let Boo = StrTrim(strNew, " ")                     '    Boo is  False  - nothing was trimmed
    'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strNew)              '   "Pog" & Chr(0) & " "
     Let Boo = StrTrimWU(StrPtr(strNew), StrPtr(" "))   '    Boo is  False  - nothing was trimmed
    'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strNew)             '  "Pog" & Chr(0) & " "
    ' 2c) VBA  Trim
     Let strNew = Trim(strBSTR): Debug.Print strNew & "Z"           '  Pog Z
    'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strNew)              '  "Pog" & Chr(0)
    
    End Sub

  10. #10
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,468
    Rep Power
    10
    Coding for this main forum question
    https://eileenslounge.com/viewtopic....324964#p324964
    https://eileenslounge.com/viewtopic....324975#p324975



    Code:
    Option Explicit  ' Destination Points to the starting address of the copied block’s destination.            Source Points to the starting address of the block of memory to copy               Length Specifies the size, in bytes, of the block of memory to copy.
     #If VBA7 Then
      Private Declare PtrSafe Sub VBGetTarget Lib "kernel32" Alias "RtlMoveMemory" (Target As Any, ByVal lPointer As LongPtr, ByVal cbCopy As LongPtr)
     #Else
      Private Declare Sub VBGetTarget Lib "kernel32" Alias "RtlMoveMemory" (Target As Any, ByVal lPointer As Long, ByVal cbCopy As Long)
     #End If
    Sub LongType() '        https://www.excelfox.com/forum/showthread.php/2404-Notes-tests-ByVal-ByRef-Application-Run-OnTime-Multiple-Variable-Arguments-ByRef-ByVal?p=11888&viewfull=1#post11888     https://www.excelfox.com/forum/showthread.php/2404-Notes-tests-ByVal-ByRef-Application-Run-OnTime-Multiple-Variable-Arguments-ByRef-ByVal/page4    https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-Pasting-API-Cliipboard-issues-and-Rough-notes-on-Advanced-API-stuff?p=17881&viewfull=1#post17881
    Dim LngDest As Long, LngSource As Long
    Rem 1  Biggest long number
    ' 1a)
     Let LngSource = 1073741824 + 1073741823 ' =2147483647      1073741824 is 2^30 which is the last but 1 (31th counting from the right), of 32 bits in the 32 Bit binary representation of a number       1073741823 is the resulting decimal you get if you have a 1 in the first 30, counting from the right, of a binary number         decimal 2147483647 is in binary 31 digits  1111111111111111111111111111111
    VBGetTarget LngDest, VarPtr(LngSource), 4 ' Anything less than 4 will give the wrong number
    Debug.Print LngDest '   2147483647     (31 digits 1111111111111111111111111111111)
     
     Let LngDest = 0
    VBGetTarget LngDest, VarPtr(LngSource), 3
    Debug.Print LngDest '    16777215      (24 digits 111111111111111111111111)
    
     Let LngDest = 0
    VBGetTarget LngDest, VarPtr(LngSource), 2
    Debug.Print LngDest '    65535         (16 digits 1111111111111111)
     
     Let LngDest = 0
    VBGetTarget LngDest, VarPtr(LngSource), 1
    Debug.Print LngDest '     255          (8 digits 11111111)
    
    
    Rem 2  Small long number
     Let LngSource = 2
     Let LngDest = 0
    VBGetTarget LngDest, VarPtr(LngSource), 4
    Debug.Print LngDest '      2
     
     Let LngDest = 0
    VBGetTarget LngDest, VarPtr(LngSource), 3
    Debug.Print LngDest '      2
     
     Let LngDest = 0
    VBGetTarget LngDest, VarPtr(LngSource), 2
    Debug.Print LngDest '      2
     
     Let LngDest = 0
    VBGetTarget LngDest, VarPtr(LngSource), 1
    Debug.Print LngDest '      2
    
    
    Rem 3  Number decimal  511    (9 digits 111111111)
     Let LngSource = 511
     Let LngDest = 0
    VBGetTarget LngDest, VarPtr(LngSource), 2
    Debug.Print LngDest '      511          (9 digits 111111111)
     
     Let LngDest = 0
    VBGetTarget LngDest, VarPtr(LngSource), 1
    Debug.Print LngDest '      255          (8 digits 11111111)
     
     
     Let LngDest = 0 '          LngSource = 511   ->  (9 digits 111111111)
    VBGetTarget LngDest, VarPtr(LngSource) + 1, 1
    Debug.Print LngDest '      1             ( 00000001  )
    End Sub



    Share ‘kernel32.dll’ https://app.box.com/s/124tsibbnl7pk1xz7assmzivuyyfplo3
    Share ‘rpiAPI.dll’ https://app.box.com/s/xfng1rft9mawgcpxlu5z64pps2sg7grv
    Attached Files Attached Files
    Last edited by DocAElstein; 02-07-2025 at 03:44 PM.

Similar Threads

  1. VBA to Reply All To Latest Email Thread
    By pkearney10 in forum Outlook Help
    Replies: 11
    Last Post: 12-22-2020, 11:15 PM
  2. Appendix Thread. Diet Protokol Coding Adaptions
    By DocAElstein in forum Test Area
    Replies: 6
    Last Post: 09-05-2019, 10:45 AM
  3. Replies: 19
    Last Post: 04-20-2019, 02:38 PM
  4. Search List of my codes
    By PcMax in forum Excel Help
    Replies: 6
    Last Post: 08-03-2014, 08:38 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •