Search code examples
sortingvbscripthtml4

sorting in visual basic?

I've got lots of folders each with a number of HTML files in them some as many as 70 files in a folder and asked a friend to help me make a bulk edit of these files to change their background and font colors as well as add a link at the bottom to go to the next file in the folder and this is what he sent me .. it was a .vbs file

'Here are the settings
'Be warned this is old fashioned preHTML5 stuff no css. But well I guess it could be implemented as well
'I think most of the replacements are pretty straight forward
'Run this script in a folder with all the files for one story
'Running it more then once can have unforseen consequences :)
background="black"
foreground="white"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSuperFolder = objFSO.GetFolder(".")
Call ShowFiles (objSuperFolder)

WScript.Quit 0


Sub ShowFiles(fFolder)
Set objFolder = objFSO.GetFolder(fFolder.Path)
Set colFiles = objFolder.Files

Dim a(50000)
Dim b(50000)
i = 1
For Each objFile In colFiles
If UCase(objFSO.GetExtensionName(objFile.name)) = "HTML" Then
    a(i) = objFile.Path
    b(i)=objFile.Name
    i = i + 1
End If
Next

j=i

For z = 1 To j-1
        Set objFile2 = objFSO.OpenTextFile(a(z), 1)
        strText = objFile2.ReadAll
        strText = Replace(strText, "<body>", "<body bgcolor=""" +background+""">")
        strText = Replace(strText, "<html>", "<html><font color=""" +foreground+""">")
        strText = Replace(strText, "</html>", "</font></html>")
        'Add the link to next chapter
        If z < j-1 Then
            strText = Replace(strText,"</body>","<a href="""+b(z+1)+""">Link to next chapter!</a></body>")
        End If
        objFile2.Close
        Set objFile2 = objFSO.OpenTextFile(a(z), 2)
        objFile2.Write strText
        objFile2.Close
Next
End Sub

and for the most part it works great except that it linked 1 to 10 then 11, 12, ... 19, 2, 20, 21 and so on i'm trying to figure out how to fix it so the links go from 1 to 2, 3, ... 9, 10, 11... the HTML file names are all the same in a given folder except the number at the end Name0.html Name1.html Name2.html ... Name9.html Name10.html Name11.html etc... BTW the html files are generated by a program i downloaded so i can recreate them easy enough if a mistake is made oh and i also wanted to add changing the font size as well but if it's to much trouble i can easily continue to use the zoom feature to work around that

Added in respond to the first answer:

no i can not control the output of the original programs numbering though if someone had a quick VBS script to change the files to a 3 digit format for the numbers that'd be a lovely workaround solution

http://helloacm.com/bubble-sort-in-vbscript/ This looks like it might be a step in the right direction maybe? Sorting arrays numerically and alphabetically(like Windows Explorer) without using StrCmpLogicalW or shlwapi.dll - ASP.NET VB or this?

Solution

  • Same friend finally got around to fixing the code up and here is the final working version 

    'Here are the settings
'Be warned this is old fashioned preHTML5 stuff no css. But well I guess it could be implemented as well
'I think most of the replacements are pretty straight forward
'Run this script in a folder with all the files for one story
'Running it more then once can have unforseen consequences :)
background="black"
foreground="white"
size="6" 'Setting go from 1 to 7

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSuperFolder = objFSO.GetFolder(".")
Call ShowFiles (objSuperFolder)

WScript.Quit 0


Sub ShowFiles(fFolder)
    Set objFolder = objFSO.GetFolder(fFolder.Path)
    Set colFiles = objFolder.Files

    Set objRE = New RegExp

    With objRE
        .Pattern    = "(\d*)\.html"
        .IgnoreCase = True
        .Global     = False
    End With

    Dim a(50000)
    Dim b(50000)

    'From here on there is the rename part
    Dim arr(3)
    arr(0)="0000"
    arr(1)="000"
    arr(2)="00"
    arr(3)="0"
    For Each objFile In colFiles
        If UCase(objFSO.GetExtensionName(objFile.name)) = "HTML" Then
            Set objMatch = objRE.Execute( objFile.Name )
            If objMatch.Count = 1 Then
                Dim ll,sttt
                sttt=objMatch.Item(0).Submatches(0)
                ll=Len(sttt)
                'WScript.Echo "Old name" & objMatch.Item(0)
                strNewName = objRE.Replace( objFile.Name, arr(ll)&sttt&".html")
                'WScript.Echo "New name" & strNewName
                objFile.Name=strNewName
            End If
        End If
    Next
    ''The renaming ends here and we're on to business as usual

    i = 1
    Set objFolder = objFSO.GetFolder(fFolder.Path)
    Set colFiles = objFolder.Files
    For Each objFile In colFiles
        If UCase(objFSO.GetExtensionName(objFile.name)) = "HTML" Then
            a(i) = objFile.Path
            b(i)=objFile.Name
            i = i + 1
        End If
    Next

    j=i

    For z = 1 To j-1
            Set objFile2 = objFSO.OpenTextFile(a(z), 1)
            strText = objFile2.ReadAll
            strText = Replace(strText, "<body>", "<body bgcolor=""" +background+""">")
            strText = Replace(strText, "<html>", "<html><font size="""+size+""" color=""" +foreground+""">")
            strText = Replace(strText, "</html>", "</font></html>")
            'Add the link to next chapter
            If z < j-1 Then
                strText = Replace(strText,"</body>","<p><a href="""+b(z+1)+""">Link to next chapter!</a></p></body>")
            End If
            objFile2.Close
            Set objFile2 = objFSO.OpenTextFile(a(z), 2)
            objFile2.Write strText
            objFile2.Close
    Next
End Sub