Promote your website with your sitemap

An updated sitemap for your website created from the local website files or backup on your computer. Use this script to start promoting your hard coded website in a breeze.

The basic script

Below is the script. Open notepad and copy 'n paste the code below. Then save it as "CreateSitemap.vbs" (or whatever filename you want, as long as it ends on .vbs).

' =============================================================
'
' Scripname:      CreateSitemap.vbs
' This script creates a sitemap for your website from your local harddisk
'
' See the tutorial on:
'     http://sitejunction.awardspace.com/sitemap_creator/
' for all the script details.
'
' Creator: Erick Hiemstra - August 2009
'
' =============================================================

OPTION EXPLICIT

' ----------------------------------------------------------
' SETTINGS
' ----------------------------------------------------------
Const conLocalWWWRoot = "C:\MyDocuments\html\MySite\"
Const conSitemapLocation = "C:\MyDocuments\html\MySite\sitemap.xml"
Const conWebsiteRootURL = "http://sitejunction.awardspace.com/sitemap_creator/"
Const conDefaultChangefreq = "monthly"
Const conDefaultPriority = "0.5"
Const conFilextensionsToIndex = "htm; html; php; asp"
Const conIndexPageRewrite = True
Const conIndexPages = "index.htm; index.html; index.php; index.asp; default.asp; default.aspx; index.aspx"
Const conFoldersToExclude = "includes; images; admin; administrator; searchresults; search"
Const conFilesToExclude = "configuration.php; google4d25f49a89699762.html"

' ----------------------------------------------------------
' START THE ACTION..
' ----------------------------------------------------------
Main
msgbox "done"

' ----------------------------------------------------------
' SUBS & FUNCTIONS
' ----------------------------------------------------------
Sub Main
     CreateSitemapFile(IndexFolders(conLocalWWWRoot, ""))
End Sub

Function IndexFolders(strFolderToIndex, strFolder)

     Dim arrFoldersToExclude
     arrFoldersToExclude = Split(conFoldersToExclude,";")     
     
     Dim arrValidFileExtensions
     arrValidFileExtensions = split(conFilextensionsToIndex,";")
     
     Dim arrIndexpages
     arrIndexpages = Split(conIndexPages,";")
          
     Dim arrFilesToExclude
     arrFilesToExclude = Split(conFilesToExclude,";")
     
     
     Dim fso, fo
     Set fso = CreateObject("Scripting.FileSystemObject")
     Set fo = fso.GetFolder(strFolderToIndex)
     
     Dim strFolderToExclude
     strFolderToExclude = False
     
     Dim foldertoexclude
     For each foldertoexclude in arrFoldersToExclude
          If LCase(fo.name) = LCase(Trim(foldertoexclude)) Then
               strFolderToExclude = True
          End If
     Next
     
     If strFolderToExclude = False Then
     
          Dim file
          For each file in fo.files
          
               Dim strFileToIndex
               strFileToIndex = True
               
               Dim filetoexclude
               For each filetoexclude in arrFilesToExclude
                    If lcase(Trim(filetoexclude)) = file.name Then
                         strFileToIndex = False
                    End If
               Next
               
               If strFileToIndex = True Then
               
                    Dim strFileExtension
                    strFileExtension = fso.GetExtensionName(file)
                    
                    Dim extension
                    For each extension in arrValidFileExtensions
                    
                         If LCase(strFileExtension) = LCase(Trim(extension)) Then
                         
                              strFoldersIndex = strFoldersIndex & VbTab & "<url>" & VbCrlf
                              
                              Dim filename, strFilename
                                   
                              If conIndexPageRewrite = True Then
                                   For each filename in arrIndexpages
                                        If LCase(file.Name) = LCase(Trim(filename)) Then
                                             strFilename = ""
                                             exit for
                                        Else
                                             strFilename = file.Name
                                        End If
                                   Next
                              Else
                                   strFilename = file.Name
                              End If
                              
                              strFoldersIndex = strFoldersIndex & VbTab & VbTab & "<loc>" & conWebsiteRootURL & strFolder & strFilename & "</loc>" & VbCrlf
                              
                              Dim strMonth
                              strMonth = Month(file.DateLastModified)
                              
                              If strMonth < 10 Then
                                   strMonth = "0" & strMonth
                              End If
                              
                              Dim strDay
                              strDay = Day(file.DateLastModified)
                              
                              If strDay < 10 Then
                                   strDay = "0" & strDay
                              End If                              
                              
                              strFoldersIndex = strFoldersIndex & VbTab & VbTab & "<lastmod>" & Year(file.DateLastModified) & "-" & strMonth & "-" & strDay & "</lastmod>" & VbCrlf
                              strFoldersIndex = strFoldersIndex & VbTab & VbTab & "<changefreq>" & conDefaultChangefreq & "</changefreq>" & VbCrlf
                              strFoldersIndex = strFoldersIndex & VbTab & VbTab & "<priority>" & conDefaultPriority & "</priority>" & VbCrlf
                              strFoldersIndex = strFoldersIndex & VbTab & "</url>" & VbCrlf
                         End if
                    Next
               End If
          Next

          Dim folder, strFoldersIndex
          For each folder in fo.SubFolders

               strFoldersIndex = strFoldersIndex & IndexFolders(folder.Path, strFolder & folder.Name & "/" )
               
          Next
     End If

     Set fo = nothing
     Set fso = nothing
     
     IndexFolders = strFoldersIndex
     
End Function

Sub CreateSitemapFile(strFileContents)

     Dim stmUTF8
     Set stmUTF8 = CreateObject("ADODB.Stream")
     With stmUTF8
          .Open
          .Type = 2
          .Charset = "utf-8"
          .WriteText "<?xml version=""1.0"" encoding=""UTF-8""?>" & VbCrlf
          .WriteText "<urlset xmlns=""http://www.sitemaps.org/schemas/sitemap/0.9"">" & VbCrlf
          .WriteText strFileContents
          .WriteText "</urlset>"
          .SaveToFile conSitemapLocation, 2
          .Close
     End With

End Sub

You can also download the script as a text file here. Right click with you mouse on the download link, choose "save as" and change the *.txt extension into the extension *.vbs. Later on you can always use notepad to open the file again to change variables.

Got any problems with downloading this script sample? Please send me an e-mail, so I can change the text on this page so everybody will understand it and can enjoy the power and advantages of scripting.

In the next chapter I tweak this script so you can use it directly from your desktop...

« previous: Introduction | next: follow soon... »