Page 17 of 19 FirstFirst ... 71516171819 LastLast
Results 161 to 170 of 186

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

  1. #161
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,402
    Rep Power
    10
    A,jdcDS;HS

    lateragain









    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.youtube.com/watch?v=oVb1RfcSHLM&lc=UgwTq-jZlZLnLQ5VB8Z4AaABAg.9Hroz-OyWog9tYjSMc1qjA
    https://www.youtube.com/watch?v=0pbsf6sox34&lc=Ugxp9JFvvejnqA68W1t4AaABAg
    https://www.youtube.com/watch?v=kfQC-sQxMcw&lc=UgyCxQWypNIhG2nUn794AaABAg.9q1p6q7ah839tUQl_92m vg
    https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgyOh-eR43LvlIJLG5p4AaABAg.9isnKJoRfbL9itPC-4uckb
    https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugy1B1aQnHq2WbbucmR4AaABAg.9isY3Ezhx4j9itQLuif2 6T
    https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgxxajSt03TX1wxh3IJ4AaABAg.9irSL7x4Moh9itTRqL7d Qh
    https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugxa2VYHMWJWXA6QI294AaABAg.9irLgSdeU3r9itU7zdnW Hw
    https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgwJAAPbp8dhkW2X1Uh4AaABAg.9iraombnLDb9itV80HDp Xc
    https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgzIzQ6MQ5kTpuLbIuB4AaABAg.9is0FSoF2Wi9itWKEvGS Sq
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iK75iCEaGN
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iK7XF33njy
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iKCSgpAqA1
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iKCy--3x8E
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwNaJiNATXshvJ0Zz94AaABAg.9iEktVkTAHk9iF9_pdsh r6
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iFAZq-JEZ-
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgxV2r7KQnuAyZVLHH54AaABAg.9iDVgy6wzct9iFBxma9z XI
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugx12mI-a39T41NaZ8F4AaABAg.9iDQqIP56NV9iFD0AkeeJG
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwnYuSngiuYaUhEMWN4AaABAg.9iDQN7TORHv9iFGQQ5z_ 3f
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwJ3yzdk_EE98dndmt4AaABAg.9iDLC2uEPRW9iFGvgk11 nH
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgyDWAVqCa4yMot463x4AaABAg.9iH3wvUZj3n9iHnpOxOe Xa
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwvLFdMEAba5rLHIz94AaABAg.9iGReNGzP4v9iHoeaCpT G8
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iHpsWCdJ5I
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

    KJHDHkj

  2. #162
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,402
    Rep Power
    10
    Uploading files is not obvious…
    _1 ) Starts with Paper Clip icon at top of Editor Window. That icon will be present in the initial Post Editor, but it may not always be available for further Replys. You may need first to “Go Advanced
    GoAdvancedReplyWindow.JPG : GoAdvanced1.JPG
    https://imgur.com/1A9qWQM : https://imgur.com/UXBZ4oJ

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

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

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

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

    _-.----
    You can also get thereabouts with the manage attachments option which you will see when you “Go Advanced
    ManageAttachments.JPG
    https://imgur.com/KxTxRoC
    Last edited by DocAElstein; 12-25-2023 at 01:07 AM.

  3. #163
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,402
    Rep Power
    10
    Some extra notes for this Post
    https://www.excelfox.com/forum/showt...ll=1#post23399



    Code:
    Sub GenerateWorkbooksPerName()
        
        Const REPEATING_ROWS As Long = 6
        Const NAME_DELIMITER As String = " "
        
        Dim swb As Workbook: Set swb = ThisWorkbook
        Dim sws As Worksheet: Set sws = swb.Worksheets("CROSSACT")
        
        Dim FirstRow As Long: FirstRow = REPEATING_ROWS + 1
        
        With sws.UsedRange
            If .Rows.Count < FirstRow Then Exit Sub
        End With
        
        Application.ScreenUpdating = False
        
        sws.Copy
        
        Dim dwb As Workbook: Set dwb = Workbooks(Workbooks.Count)
        Dim dws As Worksheet: Set dws = dwb.Sheets(1)
        
        With dws.UsedRange
            .Resize(.Rows.Count - REPEATING_ROWS).Offset(REPEATING_ROWS).Clear
        End With
        
        Dim dfCell As Range: Set dfCell = dws.Cells(FirstRow, "A")
        
        Dim dFolderPath As String:
        dFolderPath = swb.Path & Application.PathSeparator
    
        Dim ndLen As Long: ndLen = Len(NAME_DELIMITER)
        
        Dim r As Long, dCount As Long, dFilePath As String, dName As String
        
        For r = FirstRow To sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
            sws.Rows(r).Copy dfCell
            dName = CStr(sws.Cells(r, "A").Value) & NAME_DELIMITER _
                & CStr(sws.Cells(r, "B").Value)
            If Len(dName) > ndLen Then
                dws.Name = dName
                dFilePath = dFolderPath & dName & ".xlsx"
                Application.DisplayAlerts = False
                    dwb.SaveAs dFilePath, xlOpenXMLWorkbook
                Application.DisplayAlerts = True
                dCount = dCount + 1
            End If
        Next r
        
        dwb.Close SaveChanges:=False
        
        Application.ScreenUpdating = True
        
        MsgBox dCount & " workbook" & IIf(dCount = 1, "", "s") & " generated.", _
            IIf(dCount = 0, vbCritical, vbInformation)
        
    End Sub

    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.youtube.com/watch?v=jTmVtPHtiTg&lc=Ugy_RiNN_kAqUvZ8W994AaABAg
    https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNsaS3Lp1
    https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgR1EPUkhw
    https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNe_XC-jK
    https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgNPOdiDuv
    https://www.youtube.com/watch?v=QjEWAJ3d-jw&lc=UgxJLVpwY8fIla7G-pN4AaABAg.9BLeCWVhxdG9wgN7AC7wAc
    https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M
    https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg
    https://www.youtube.com/watch?v=DVFFApHzYVk&lc=Ugyi578yhj9zShmhuPl4AaABAg
    https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgxvxlnuTRWiV6MUZB14AaABAg
    https://www.youtube.com/watch?v=_8i1fVEi5WY&lc=Ugz0ptwE5J-2CpX4Lzh4AaABAg
    https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxoHAw8RwR7VmyVBUt4AaABAg.9C-br0lEl8V9xI0_6pCaR9
    https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=Ugz5DDCMqmHLeEjUU8t4AaABAg.9bl7m03Onql9xI-ar3Z0ME
    https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgxYnpd9leriPmc8rPd4AaABAg.9gdrYDocLIm9xI-2ZpVF-q
    https://www.youtube.com/watch?v=0ltJS7uHfK4&lc=UgyjoPLjNeIAOMVH_u94AaABAg.9id_Q3FO8Lp9xHyeYSuv 1I
    https://www.reddit.com/r/windowsxp/comments/pexq9q/comment/k81ybvj/?utm_source=reddit&utm_medium=web2x&context=3
    https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgxYgiEZuS9I3xkjJv54AaABAg
    https://www.youtube.com/watch?v=bs-urI_o8jo&lc=UgyBACXgNY4j_cHgH5J4AaABAg.9oTkVdzfqfm9wlhQrYJP 3M
    ttps://www.youtube.com/watch?v=LP9fz2DCMBE
    https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg
    https://www.youtube.com/watch?v=LP9fz2DCMBE&lc=UgzbPgJUMCztIOQDym14AaABAg.9wdo_rWgxSH9wdpcYqrv p8
    ttps://www.youtube.com/watch?v=bFxnXH4-L1A
    https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxuODisjo6cvom7O-B4AaABAg.9w_AeS3JiK09wdi2XviwLG
    https://www.youtube.com/watch?v=bFxnXH4-L1A&lc=UgxBU39bTptFznDC1PJ4AaABAg
    ttps://www.youtube.com/watch?v=GqzeFYWjTxI
    https://www.youtube.com/watch?v=GqzeFYWjTxI&lc=UgwJnJDJ5JT8hFvibt14AaABAg
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 11-30-2023 at 03:18 PM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  4. #164
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,402
    Rep Power
    10
    Some extra notes for these forum Threads and posts
    http://www.eileenslounge.com/viewtop...313468#p313468
    https://www.excelfox.com/forum/showt...age2#post23774



    Code:
    Option Explicit
    Dim Clm As Long, Reocopy As Long ' variable for column number to put file or folder details in, number representin the copy of the second macro
    
    ' Select the cell where a main folder(s) last bit of its  Parf  will go. This macro will list, starting with the folder name under that patf bit, a few property names. In the naxt column the corresponding property value will be given
    '
    Sub PassFolderForReocursing1()
    'Sub SchellFolderDetails2() '  Jan 2024  https://www.excelfox.com/forum/showthread.php/2936-YouTube-Video-making-and-editing-etc-coupled-to-excelfox-(-windows-Movie-Maker-)/page2#post23775
    Rem 0
     Let Clm = 0: Reocopy = -1
    Rem 1
    Dim Ws As Worksheet: Set Ws = Me   '   G:\YouTubeVideos&Anaslysis&HackingTricks\VideoRecordingEditing\Windows (Live) Movie Maker\Movie Maker Versions.xls
    ' 1b
    Dim Parf As String
     Let Parf = ThisWorkbook.Path & "\Versions  Downloads Exes\Verson 2, 2 1 2 5 Downloads 2,1\50 Euro Keks"
     Let Parf = ThisWorkbook.Path & "\50 Euro Keks"
    ' 1c
        If Len(Parf) - Len(Replace(Parf, "\", "", 1, -1, vbBinaryCompare)) >= 2 Then
         Let ActiveCell = Mid(Parf, InStrRev(Parf, "\", InStrRev(Parf, "\", -1, vbBinaryCompare) - 1, vbBinaryCompare))
        Else
         Let ActiveCell = Parf
        End If
    Rem 2  Windows Shell object
    Dim objShell As Shell32.Shell: 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 objFolder As Shell32.Folder: Set objFolder = objShell.Namespace(Parf)  '
    Rem 3 Movie Maker Folder Property names and Property values.
    Dim Fil As Shell32.FolderItem
        For Each Fil In objFolder.Items  '  We loop through all items to find the Movie Maker folder ' =======
            If Fil.Name = "Movie Maker" Then
            Dim Rw As Long: Let Rw = 1
             'Let ActiveCell.Offset(Rw, 0) = "Name": Let ActiveCell.Offset(Rw, 1) = objFolder.GetDetailsOf(Fil, 0)
             Let ActiveCell.Offset(Rw, 0) = objFolder.GetDetailsOf("Goolies", 0): Let ActiveCell.Offset(Rw, 1) = objFolder.GetDetailsOf(Fil, 0)
             'Let ActiveCell.Offset(Rw + 1, 0) = "Größe": Let ActiveCell.Offset(Rw + 1, 1) = objFolder.GetDetailsOf(Fil, 1)
             Let ActiveCell.Offset(Rw + 1, 0) = objFolder.GetDetailsOf(71, 1): Let ActiveCell.Offset(Rw + 1, 1) = objFolder.GetDetailsOf(Fil, 1)
             'Let ActiveCell.Offset(Rw + 2, 0) = "Elementtyp": Let ActiveCell.Offset(Rw + 2, 1) = objFolder.GetDetailsOf(Fil, 2)
             Let ActiveCell.Offset(Rw + 2, 0) = objFolder.GetDetailsOf(Parf, 2): Let ActiveCell.Offset(Rw + 2, 1) = objFolder.GetDetailsOf(Fil, 2)
             'Let ActiveCell.Offset(Rw + 3, 0) = "Änderungsdatum": Let ActiveCell.Offset(Rw + 3, 1) = Left(objFolder.GetDetailsOf(Fil, 3), InStr(1, objFolder.GetDetailsOf(Fil, 3), " ", vbBinaryCompare))
             Let ActiveCell.Offset(Rw + 3, 0) = objFolder.GetDetailsOf(Ws, 3): Let ActiveCell.Offset(Rw + 3, 1) = Left(objFolder.GetDetailsOf(Fil, 3), InStr(1, objFolder.GetDetailsOf(Fil, 3), " ", vbBinaryCompare))
             'Let ActiveCell.Offset(Rw + 4, 0) = "Erstelldatum": Let ActiveCell.Offset(Rw + 4, 1) = Left(objFolder.GetDetailsOf(Fil, 4), InStr(1, objFolder.GetDetailsOf(Fil, 4), " ", vbBinaryCompare))
             Let ActiveCell.Offset(Rw + 4, 0) = objFolder.GetDetailsOf(Left("gh", 2), 4): Let ActiveCell.Offset(Rw + 4, 1) = Left(objFolder.GetDetailsOf(Fil, 4), InStr(1, objFolder.GetDetailsOf(Fil, 4), " ", vbBinaryCompare))
        '     Let ActiveCell.Offset(Rw + 9, 0) = "Dateiversion": Let ActiveCell.Offset(Rw + 9, 1) = objFolder.GetDetailsOf(Fil, 166)
             Let ActiveCell.Offset(Rw + 5, 0) = objFolder.GetDetailsOf("Bum", 166): Let ActiveCell.Offset(Rw + 5, 1) = objFolder.GetDetailsOf(Fil, 166)
            
             Rem 4
             ActiveCell.Offset(0, 2).Activate
             ' 4b
             Call ReoccurringFileFolderProps(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 Fil ' ===========================================================================================
    End Sub
    
    '    https://www.excelfox.com/forum/showthread.php/2936-YouTube-Video-making-and-editing-etc-coupled-to-excelfox-(-windows-Movie-Maker-)/page2#post23774
    Private Sub ReoccurringFileFolderProps(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 vallue will be 2  and so on.  So effectively it tells us which copy is running at any time
    Rem 1
    Dim objShell As Shell32.Shell: 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 objFolder As Shell32.Folder: Set objFolder = objShell.Namespace(Pf)  '
    Rem 2
    Dim Fil As Shell32.FolderItem
        For Each Fil In objFolder.Items ' ======= Main Loop ==================================================|
        ' Dim Clm As Long: ' Global variable
         Let Clm = Clm + 1
        Dim Rw As Long: Let Rw = 1
             Let ActiveCell.Offset(Rw, Clm) = objFolder.GetDetailsOf(Fil, 0)
             Let ActiveCell.Offset(Rw + 1, Clm) = objFolder.GetDetailsOf(Fil, 1)
             Let ActiveCell.Offset(Rw + 2, Clm) = objFolder.GetDetailsOf(Fil, 2)
             Let ActiveCell.Offset(Rw + 3, Clm) = Left(objFolder.GetDetailsOf(Fil, 3), InStr(1, objFolder.GetDetailsOf(Fil, 3), " ", vbBinaryCompare))
             Let ActiveCell.Offset(Rw + 4, Clm) = Left(objFolder.GetDetailsOf(Fil, 4), InStr(1, objFolder.GetDetailsOf(Fil, 4), " ", vbBinaryCompare))
        '                                     Let ActiveCell.Offset(Rw + 9, 0) = "Dateiversion": Let ActiveCell.Offset(Rw + 9, 1) = objFolder.GetDetailsOf(Fil, 166)
             Let ActiveCell.Offset(Rw + 5, Clm) = objFolder.GetDetailsOf(Fil, 166)
            '_________________________________________________________________________________________________
            ' 2b  Here we may pause the macro, whilst another copy of it is started
            If objFolder.GetDetailsOf(Fil, 2) = "Dateiordner" Then Call ReoccurringFileFolderProps(Pf & "\" & objFolder.GetDetailsOf(Fil, 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 Fil ' ============================== Main Loop  =================================================|
     
     
     Let Reocopy = Reocopy - 1  ' We are finished at this point with this running copy of the macro.  This code line will reduce the v
    End Sub
    Last edited by DocAElstein; 01-21-2024 at 04:54 PM.

  5. #165
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,402
    Rep Power
    10
    Last edited by DocAElstein; 01-17-2024 at 06:53 PM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  6. #166
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,402
    Rep Power
    10
    Some extra notes for this forum post: https://eileenslounge.com/viewtopic....313578#p313578

    I took a look at this



    Here is the test file and folder details https://i.postimg.cc/pX90bM2Q/MM-Pro...est-Folder.jpg https://i.postimg.cc/2SN78v0H/MM-Pro...est-Folder.jpg


    Sample File ___ sample.wmv https://app.box.com/s/leu06ql1fu9uzt59wnoizedg85qoo7k4
    Folder ___ MMPropertyTest https://app.box.com/s/27u7dyjee3rez44pdjq52uu2e7tgzu8v
    File with coding in ___ Movie Maker Versions.xls https://app.box.com/s/axle7nflnmgkfbztto1wsmhc2ml2ynes
    ' c009 Built in VBA FileLen( ) way , ' c109 Scripting Runtime Object Library way
    Code:
    Sub SumSnbs_() '         http://www.eileenslounge.com/viewtopic.php?p=313578#p313578     https://www.snb-vba.eu/VBA_Bestanden.html#L_2.17
    Dim FileThing As Variant, FolderThing As Variant, FlFldrNme As String
    '  c009   Built in  VBA FileLen( )  way
     Let FlFldrNme = Dir(PathName:=ThisWorkbook.Path & Application.PathSeparator & "*", Attributes:=vbDirectory + vbNormal)
        Do While Left(FlFldrNme, 1) = "."    '    https://www.accessforums.net/showthread.php?t=60879&p=325335#post325335
         Let FlFldrNme = Dir
        Loop '  While Left(FlFldrNme, 1) = "."
        Do While FlFldrNme <> ""
        Debug.Print FlFldrNme & "     ";
         Let FileThing = FileLen(ThisWorkbook.Path & "\" & FlFldrNme) '  VBA built in way
            If FileThing = 0 Then  '  Probably got a Folder
            '  c109    Scripting Runtime Object Library  way
             Let FolderThing = CreateObject("scripting.filesystemobject").GetFolder(ThisWorkbook.Path & "\" & FlFldrNme).Size
             Debug.Print FolderThing
            Else  '  Probably got a file
             Debug.Print FileThing & "     "; '  VBA built in way
             Let FileThing = CreateObject("scripting.filesystemobject").GetFile(ThisWorkbook.Path & "\" & FlFldrNme).Size
             Debug.Print FileThing            '  c109    Scripting Runtime Object Library  way
            End If
         Let FlFldrNme = Dir
        Loop ' While vTemp <> ""
    End Sub
    Results:
    Code:
     sample.wmv     643170      643170 
    Microsoft Scripting Runtime  Library referrence.JPG     96231      96231 
    snbsize.JPG     96857      96857 
    Windows Script Host Object Model  Library referrence.JPG     85009      85009 
    MySubFolder      96857 
    Movie Maker Versions.xls     1630720      1630720
    Conclusions:
    Both the in-built VBA file size function and the file size from scripting file system object appear to give a nice Bytes size number
    The folder size from the scripting file system object gives a similar number. (Note that in the folder, MySubFolder, is a single file, snbsize.JPG, and I also ran the code with nothing in MySubFolder and got a size of 0. So it would appear that an empty folder has a size of the things in it.




    ' c309 Microsoft Shell Controls And Automation way

    Code:
    Sub MicrosoftShellControlsAndAutomation() '  referrence  Microsoft Shell Controls And Automation     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
    '  c309  Microsoft Shell Controls And Automation   way
    Dim oShell As Shell32.Shell: Set oShell = New Shell32.Shell
     Dim Itm As Shell32.FolderItem, objFolder As Shell32.Folder: Set objFolder = oShell.Namespace(ThisWorkbook.Path)
        For Each Itm In objFolder.Items
         Debug.Print Itm.Name & "   " & Itm.Size & "   " & objFolder.GetDetailsOf(Itm, 1)
        Next Itm
    End Sub
    Results:
    Code:
     sample.wmv   643170   628 KB
    Microsoft Scripting Runtime  Library referrence.JPG   96231   93,9 KB
    snbsize.JPG   96857   94,5 KB
    Windows Script Host Object Model  Library referrence.JPG   85009   83,0 KB
    MySubFolder   0   
    Movie Maker Versions.xls   1630720   1,55 MB
    Conclusion:
    The .size and .GetDetailsOf(Itm, 1) seem to give different numbers and the .size looks like the nice number
    It seems to be broken for a folder. The .size gives 0 and the .GetDetailsOf(Itm, 1) gives nothing




    ' c709 VBA Open For Input Close way

    Code:
    '   c709    VBA  Open For Input  Close    way
    Sub c709() '  https://www.snb-vba.eu/VBA_Bestanden.html#L_2.17    Size: file size / file length in bytes
    Dim vTemp As Variant
    Open ThisWorkbook.Path & "\" & "sample.wmv" For Input As #1
     Let vTemp = LOF(1): Debug.Print vTemp '  643170
    Close
    
    'Open ThisWorkbook.Path & "\" & "MySubFolder" For Input As #1    '  Does not work for Folders
    ' Let vTemp = LOF(1): Debug.Print vTemp
    'Close
    End Sub
    Result:
    643170
    Conclusions
    For a file, this returns the nice Byte number. (It does not work for a folder)




    The final way suggested by snb, the Windows Script Host Object Model look like it needs some more consideration, so I will look at that in the next post, https://www.excelfox.com/forum/showt...ll=1#post23918
    Last edited by DocAElstein; 01-19-2024 at 03:40 PM.

  7. #167
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,402
    Rep Power
    10
    ' c509 c609 Windows Script Host Object Model

    This does not initially seem to be doing what it was supposed to. It’s not giving any properties. For the case of a file it returns a simple string of that file. For the case of a folder it lists all in the folder

    Code:
    ' c509    c609   Windows Script Host Object Model
    Sub WindowsScriptHostObjectModel()  '        referrence  Windows Script Host Object Model              https://i.postimg.cc/k5FnwWrH/Windows-Script-Host-Object-Model-Library-referrence.jpg
    Dim wsh As WshShell: Set wsh = New WshShell
    Dim CmdString As String: Let CmdString = "cmd /c Dir " & Chr(34) & ThisWorkbook.Path & "\" & "sample.wmv" & Chr(34) & " /b":    '   Debug.Print CmdString
    Dim vTemp As Variant
     Let vTemp = wsh.Exec(CmdString).StdOut.ReadAll
    ' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(vTemp)  '  vTemp is  "sample" & "." & "wmv" & vbCr & vbLf
    ' c509    c609
     Let vTemp = CreateObject("wscript.shell").Exec(CmdString).StdOut.ReadAll
    ' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(vTemp)  '  vTemp is  "sample" & "." & "wmv" & vbCr & vbLf
     Let vTemp = Split(vTemp, vbCr & vbLf)  '   Watch : - : vTemp :  : Variant/String(0 to 1) : Tabelle4.WindowsScriptHostObjectModel   https://i.postimg.cc/JhWrbPFJ/Split-v-Temp-vb-Cr-vb-Lf.jpg
    End Sub
    Sub WindowsScriptHostObjectModel_()   '        referrence  Windows Script Host Object Model              https://i.postimg.cc/k5FnwWrH/Windows-Script-Host-Object-Model-Library-referrence.jpg
    Dim FlFldrNme As String, vTemp As Variant
      Let FlFldrNme = Dir(PathName:=ThisWorkbook.Path & Application.PathSeparator & "*", Attributes:=vbDirectory + vbNormal)
        Do While Left(FlFldrNme, 1) = "."    '    https://www.accessforums.net/showthread.php?t=60879&p=325335#post325335
         Let FlFldrNme = Dir
        Loop '  While Left(FlFldrNme, 1) = "."
    ' a) Loop through all files and folders in the main folder in the Command line string
        Do While FlFldrNme <> ""
        Debug.Print FlFldrNme & vbCr & vbLf
        ' c509    c609
         Dim CmdString As String: Let CmdString = "cmd /c Dir " & Chr(34) & ThisWorkbook.Path & "\" & FlFldrNme & Chr(34) & " /b"    '   : Debug.Print CmdString
         Let vTemp = CreateObject("wscript.shell").Exec(CmdString).StdOut.ReadAll
         'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(vTemp)  '  vTemp is  "sample" & "." & "wmv" & vbCr & vbLf
         Debug.Print vTemp
         Let FlFldrNme = Dir
        Loop ' While vTemp <> ""
    
    Debug.Print: Debug.Print
    ' b) use the main folder in the Command line string
     Let CmdString = "cmd /c Dir " & Chr(34) & ThisWorkbook.Path & Chr(34) & " /b"     '   : Debug.Print CmdString
     Let vTemp = CreateObject("wscript.shell").Exec(CmdString).StdOut.ReadAll
    'Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(vTemp)  '  vTemp is  "sample" & "." & "wmv" & vbCr & vbLf
     Debug.Print vTemp
    End Sub
    Results ' a) (Sub WindowsScriptHostObjectModel_() )
    Code:
     sample.wmv
    
    sample.wmv
    
    Microsoft Scripting Runtime  Library referrence.JPG
    
    Microsoft Scripting Runtime  Library referrence.JPG
    
    snbsize.JPG
    
    snbsize.JPG
    
    Windows Script Host Object Model  Library referrence.JPG
    
    Windows Script Host Object Model  Library referrence.JPG
    
    MySubFolder
    
    snbsize.JPG
    
    Movie Maker Versions.xls
    
    Movie Maker Versions.xls
    For the case of a file it returns a simple string of that file. For the case of a folder it lists all in the folder




    Results ' b) (Sub WindowsScriptHostObjectModel_() )
    Code:
     sample.wmv
    Microsoft Scripting Runtime  Library referrence.JPG
    snbsize.JPG
    Windows Script Host Object Model  Library referrence.JPG
    MySubFolder
    Movie Maker Versions.xls
    For the case of the main folder, all the files and folders in the main folder are listed








    folder details https://i.postimg.cc/pX90bM2Q/MM-Pro...est-Folder.jpg https://i.postimg.cc/2SN78v0H/MM-Pro...est-Folder.jpg


    Sample File ___ sample.wmv https://app.box.com/s/leu06ql1fu9uzt59wnoizedg85qoo7k4
    Folder ___ MMPropertyTest https://app.box.com/s/27u7dyjee3rez44pdjq52uu2e7tgzu8v
    File with coding in ___ Movie Maker Versions.xls https://app.box.com/s/axle7nflnmgkfbztto1wsmhc2ml2ynes
    Last edited by DocAElstein; 01-19-2024 at 02:45 AM.

  8. #168
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,402
    Rep Power
    10
    for later
    Last edited by DocAElstein; 01-20-2024 at 06:37 PM.

  9. #169
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,402
    Rep Power
    10
    Some more notes for these main forum posts
    https://eileenslounge.com/viewtopic....313622#p313622
    https://www.excelfox.com/forum/showt...age2#post23776


    https://i.postimg.cc/SQLdw105/Version-2-Files.jpg


    The basic coding to get the initial results as shown above
    What looked potentially a useful coding way I got from this good source, https://www.youtube.com/watch?v=jTmVtPHtiTg . Summarised, the coding there treats things, (I think probably everything, Folders and files), in a folder as Items of that folder. You loop through those items, and are able to get a lot of properties for each one. Each property is returned from a code line of this general form PropertyValue = objFolder.GetDetailsOf(Fil, 166) (For want of a better descriptions I will refer to this as the windows shell object way)

    The basic looping structure would then be of this sort of form
    Dim objShell As Shell32.Shell: Set objShell = New Shell32.Shell ' https://i.postimg.cc/fz9zrnnm/tools-referrences-microsoft-shell-controls-and-automation.jpg https://i.postimg.cc/sdc9s54h/tools-...automation.jpg
    Dim objFolder As Shell32.Folder: Set objFolder = objShell.Namespace(FullPathToFolder) '
    Dim Fil As Shell32.FolderItem

    __For Each Fil In objFolder.Items
    ___PropertyValue = objFolder.GetDetailsOf(Fil, 166)

    __Next Fil

    So , briefly, Fil is declared as a folder Item, and we loop through each of them in the folder. At each loop we can get a particular property from a number. In that example I have 166, which so far always seems to give me a version number.
    To get the full listing of the numbers for the different properties available, see here https://www.youtube.com/watch?v=jTmVtPHtiTg&t=560s
    https://www.youtube.com/watch?v=jTmV...8sZ9zYqog9KZ5B
    https://www.youtube.com/watch?v=jTmV...UOM9zYlZPKdOpm


    Full coding example
    As time went on, I chopped and changed the basic coding quite a bit to suit getting a better comparison of the Movie Maker folder contents. So this is just one early working example. The example is for the earliest version of Movie Maker that I could find, version 2
    In the uploaded workbook , Movie Maker Versions.xls , the coding given in this and the next post are towards the top of Worksheets Version 2 code module
    Initially I did 2 macros. The first, below analyses the main Movie Maker Folder. It makes 2 columns, the first gives the property names and in the second column it attempts to give the properties.
    The Movie Maker main program folder is also uploaded.
    Basically the macro loops through all items in the same folder as you put the Excel file containing the macro, Movie Maker Versions.xls. There is a Stop in the coding, so that you can resume if necessary until you hit the Movie Maker

    Select top left where you want the results to start, and run Sub Schell2ColumnMovieMakerFolderDetails()

    For example I selected cell A3 and ran the macro Sub Schell2ColumnMovieMakerFolderDetails()


    https://i.postimg.cc/ZRR7ZRBz/Versio...r-analysis.jpg
    Version 2 simple property macro Movie Maker folder analysis.JPG



    Code:
    ' Select top left of where Folder details should start. Folder details will be for all items that are in the Folder at the   Parf  string  There is a  Stop  so you can resume until you get the Movie Maker folder
    Private Sub Schell2ColumnMovieMakerFolderDetails()    '    https://www.youtube.com/watch?v=jTmVtPHtiTg&t=612s
    Dim Ws As Worksheet: Set Ws = Me
    '                    Windows (Live) Movie Maker        archive org details wmm2installer\Jewano Install Dec 5 2023
    Dim Parf As String
    Let Parf = ThisWorkbook.Path '  To test coding, put the  Movie Maker  main programs folder
    Dim objShell As Shell32.Shell: 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 ObjFolder As Shell32.Folder: Set ObjFolder = objShell.Namespace(Parf)
    Dim Fil As Shell32.FolderItem
        For Each Fil In ObjFolder.Items
        Dim Rw As Long: Let Rw = 1 ': Let Rw = Rw + 1
         Let ActiveCell.Offset(Rw, 0) = "Name": Let ActiveCell.Offset(Rw, 1) = ObjFolder.GetDetailsOf(Fil, 0)
         ' Or to check the property name
         Let ActiveCell.Offset(Rw, 0) = ObjFolder.GetDetailsOf("Anything", 0): Let ActiveCell.Offset(Rw, 1) = ObjFolder.GetDetailsOf(Fil, 0)
         Let ActiveCell.Offset(Rw + 1, 0) = "Größe": Let ActiveCell.Offset(Rw + 1, 1) = ObjFolder.GetDetailsOf(Fil, 1)
         Let ActiveCell.Offset(Rw + 2, 0) = "Elementtyp": Let ActiveCell.Offset(Rw + 2, 1) = ObjFolder.GetDetailsOf(Fil, 2)
         Let ActiveCell.Offset(Rw + 3, 0) = "Änderungsdatum": Let ActiveCell.Offset(Rw + 3, 1) = Left(ObjFolder.GetDetailsOf(Fil, 3), InStr(1, ObjFolder.GetDetailsOf(Fil, 3), " ", vbBinaryCompare))
         Let ActiveCell.Offset(Rw + 4, 0) = "Erstelldatum": Let ActiveCell.Offset(Rw + 4, 1) = Left(ObjFolder.GetDetailsOf(Fil, 4), InStr(1, ObjFolder.GetDetailsOf(Fil, 4), " ", vbBinaryCompare))
         Let ActiveCell.Offset(Rw + 5, 0) = "Abmessungen": Let ActiveCell.Offset(Rw + 5, 1) = ObjFolder.GetDetailsOf(Fil, 31)
         Let ActiveCell.Offset(Rw + 6, 0) = "Gesamtgröße": Let ActiveCell.Offset(Rw + 6, 1) = ObjFolder.GetDetailsOf(Fil, 57)
         Let ActiveCell.Offset(Rw + 7, 0) = "Dateierweiterung": Let ActiveCell.Offset(Rw + 7, 1) = ObjFolder.GetDetailsOf(Fil, 164)
         Let ActiveCell.Offset(Rw + 8, 0) = "Dateiname": Let ActiveCell.Offset(Rw + 8, 1) = ObjFolder.GetDetailsOf(Fil, 165)
         Let ActiveCell.Offset(Rw + 9, 0) = "Dateiversion": Let ActiveCell.Offset(Rw + 9, 1) = ObjFolder.GetDetailsOf(Fil, 166)
         Let ActiveCell.Offset(Rw + 10, 0) = "Gesamtdateigröße": Let ActiveCell.Offset(Rw + 10, 1) = ObjFolder.GetDetailsOf(Fil, 309)
         Let ActiveCell.Offset(Rw + 11, 0) = "Videokomprimierung": Let ActiveCell.Offset(Rw + 11, 1) = ObjFolder.GetDetailsOf(Fil, 311)
         Let ActiveCell.Offset(Rw + 12, 0) = "Regisseure": Let ActiveCell.Offset(Rw + 12, 1) = ObjFolder.GetDetailsOf(Fil, 312)
         Let ActiveCell.Offset(Rw + 13, 0) = "Datenrate": Let ActiveCell.Offset(Rw + 13, 1) = ObjFolder.GetDetailsOf(Fil, 313)
         Let ActiveCell.Offset(Rw + 14, 0) = "Bildhöhe": Let ActiveCell.Offset(Rw + 14, 1) = ObjFolder.GetDetailsOf(Fil, 314)
         Let ActiveCell.Offset(Rw + 15, 0) = "Einzelbildrate": Let ActiveCell.Offset(Rw + 15, 1) = ObjFolder.GetDetailsOf(Fil, 315)
         Let ActiveCell.Offset(Rw + 16, 0) = "Bildbreite": Let ActiveCell.Offset(Rw + 16, 1) = ObjFolder.GetDetailsOf(Fil, 316)
         Let ActiveCell.Offset(Rw + 17, 0) = "Kugelförmig": Let ActiveCell.Offset(Rw + 17, 1) = ObjFolder.GetDetailsOf(Fil, 317)
         Let ActiveCell.Offset(Rw + 18, 0) = "Stereo": Let ActiveCell.Offset(Rw + 10, 1) = ObjFolder.GetDetailsOf(Fil, 309)
         Let ActiveCell.Offset(Rw + 19, 0) = "Videoausrichtung": Let ActiveCell.Offset(Rw + 19, 1) = ObjFolder.GetDetailsOf(Fil, 319)
         Let ActiveCell.Offset(Rw + 20, 0) = "Gesamtbitrate": Let ActiveCell.Offset(Rw + 20, 1) = ObjFolder.GetDetailsOf(Fil, 320)
        Stop ' In case you got the wrong folder  -  keep hitting  Play button   or  F5  until the folder you want is found
        Next Fil
    End Sub





    Movie Maker https://app.box.com/s/cxvc735a85q6az2r3gtb7ii9w2p3jzpf
    Movie Maker Versions.xls https://app.box.com/s/axle7nflnmgkfbztto1wsmhc2ml2ynes
    Last edited by DocAElstein; 01-20-2024 at 10:19 PM.

  10. #170
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,402
    Rep Power
    10
    As example, after running the macro in the last post , in the same worksheet, select cell D3 and run the macro below. Details of the file should be added.

    https://i.postimg.cc/g2y0C2qk/Versio...aker-files.jpg
    Version 2 simple property macro for Movie Maker files.jpg


    Code:
    ' Select top left of where File details should start, usually column D
    Private Sub FolderFileDetails()    '    https://www.youtube.com/watch?v=jTmVtPHtiTg&t=612s
    Dim Ws As Worksheet: Set Ws = Me
    Dim Parf As String
     Let Parf = ThisWorkbook.Path & "\Movie Maker"
    Dim objShell As Shell32.Shell: 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 ObjFolder As Shell32.Folder: Set ObjFolder = objShell.Namespace(Parf)
    Dim Fil As Shell32.FolderItem
        For Each Fil In ObjFolder.Items
        Dim Clm As Long: Let Clm = Clm + 1
        Dim Rw As Long: Let Rw = 1
         Let ActiveCell.Offset(Rw, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 0)
         Let ActiveCell.Offset(Rw + 1, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 1)
         Let ActiveCell.Offset(Rw + 2, Clm - 1) = Replace(ObjFolder.GetDetailsOf(Fil, 2), "Anwendungserweiterung", "App Ext", 1, 1, vbBinaryCompare)
         Let ActiveCell.Offset(Rw + 3, Clm - 1) = Left(ObjFolder.GetDetailsOf(Fil, 3), InStr(1, ObjFolder.GetDetailsOf(Fil, 3), " ", vbBinaryCompare))
         Let ActiveCell.Offset(Rw + 4, Clm - 1) = Left(ObjFolder.GetDetailsOf(Fil, 4), InStr(1, ObjFolder.GetDetailsOf(Fil, 4), " ", vbBinaryCompare))
         Let ActiveCell.Offset(Rw + 5, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 31)
         Let ActiveCell.Offset(Rw + 6, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 57)
         Let ActiveCell.Offset(Rw + 7, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 164)
         Let ActiveCell.Offset(Rw + 8, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 165)
         Let ActiveCell.Offset(Rw + 9, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 166)
         Let ActiveCell.Offset(Rw + 10, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 309)
         Let ActiveCell.Offset(Rw + 11, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 311)
         Let ActiveCell.Offset(Rw + 12, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 312)
         Let ActiveCell.Offset(Rw + 13, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 313)
         Let ActiveCell.Offset(Rw + 14, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 314)
         Let ActiveCell.Offset(Rw + 15, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 315)
         Let ActiveCell.Offset(Rw + 16, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 316)
         Let ActiveCell.Offset(Rw + 17, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 317)
         Let ActiveCell.Offset(Rw + 18, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 309)
         Let ActiveCell.Offset(Rw + 19, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 319)
         Let ActiveCell.Offset(Rw + 20, Clm - 1) = ObjFolder.GetDetailsOf(Fil, 320)
        'Stop ' Stop after each file
        Next Fil
    End Sub
    


    Last edited by DocAElstein; 01-20-2024 at 10:18 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
  •