Development‎ > ‎VBScript‎ > ‎

Creating sitemap

While working on this website I had to create sitemap file which could be used by search engines. Initially I planned to do that using text editor macro feature but I thouth that such script might come usefull for others who are using Google's Sites.

I wrote that script just to create a sitemap for my website and thus I suspect that it might not work in some cases.
To use the script follow this procedure:
  1. Navigate to Sitemap page of your Google website
  2. Right click  somwhere in the middle of the page and click "View Page Source" (in Firefox) or "View Source" (in Internet Explorer)
  3. Search for the string "var siteMapSiteData ="
  4. Copy text which goes after the = up to the end of the line with the last three characters "}];"
    Note: If you have word wrap enabled in the editor in which you are viewing the code you might need to copy more then one line.
  5. Copy the utility code from this website and paste into any text editor
  6. Replace value in the "WEBSITE_PREFIX" variable to your website root URL
    Note: This might be your own domain (like in my case) or googlesites address
    Own domain: http://www.maciejzaleski.info
    Google site url: http://sites.google.com/site/mainfshutdown
  7. Save the code as "GenerateSiteMap.vbs"
  8. Run the utility
  9. Paste the Sitemap definition string into the popup window
  10. Click OK
If there aren't any errors you should see new file called "generated_sitemap.xml" in folder where the "GenerateSiteMap.vbs" script was saved.


Const WEBSITE_PREFIX = "http://www.maciejzaleski.info"

'You should not need to change anything below that line
'
------------------------------------------------------------------------


Dim sInput : sInput = InputBox("Please enter your sitemap definition string in a format: " & vbNewLine & vbNewLine & "[{""title"":""?"",""path"":""?"",""url"":""?""},{...},{...}]")

'Trim the input by removing any leading or trailing white characters
sInput = Trim(sInput)
 
'Remove two first brackets [{
sInput = Mid(sInput, 3)
 
'Remove two last brackets }]
sInput = Left(sInput, Len(sInput) - 2)
 
'Remove quotes from the input string
sInput = Replace(sInput, """", "")
 
'Split the input string with },{. This will place date relevant to one URL (i.e. title, path, URL) in one array cell
Dim aSitemapData
aSitemapData = Split(sInput, "},{")
 
Dim aResourceRecords
Dim iIndex : For iIndex = 0 To UBound(aSitemapData)
    'Now split the resource string into individual fields
    aResourceRecords = Split(aSitemapData(iIndex), ",")
 
    'Create dictionary object for the resource data
    Set aSitemapData(iIndex) = CreateObject("Scripting.Dictionary")
      
    aSitemapData(iIndex).Add "title", Split(aResourceRecords(0), ":")(1)
    aSitemapData(iIndex).Add "path", Split(aResourceRecords(1), ":")(1)
    aSitemapData(iIndex).Add "url", Split(aResourceRecords(2), ":")(1)
Next

 
Dim FSO, f
Set FSO = CreateObject("Scripting.FileSystemObject")
 
'Open "generated_sitemap.xml" file located in the same directory as the script
Set f = FSO.OpenTextFile("generated_sitemap.xml", 2, true)
 
'Write start of the XML document
f.WriteLine "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbNewLine &_
              "<urlset xmlns=""http://www.sitemaps.org/schemas/sitemap/0.9"">"
 
'Save data into the file
For Each dicSitemapResource In aSitemapData
    f.WriteLine "   <url>" & vbNewLine &_
            "      <loc>" & WEBSITE_PREFIX & dicSitemapResource.Item("path") & "</loc>" & vbNewLine &_
            "      <lastmod>2009-09-13</lastmod>" & vbNewLine &_
            "      <changefreq>monthly</changefreq>" & vbNewLine &_
            "      <priority>0.5</priority>" & vbNewLine &_
      "   </url>" & vbNewLine 
    Set FSO = Nothing
Next
 
'Wrap up the XML document
f.WriteLine "</urlset>"

'Close the file
f.Close

'..and release the objects
Set f = Nothing
Set FSO = Nothing
 


Comments