www.MicrosoftBob.com

FrontPage Macro: Fix Filenames
(Back to Main)

Using this FrontPage VBA Macro

This FrontPage VBA Macro is designed to fix potential filename problems by:

• Converting all filenames to lowercase.
• Converting all non-alphanumeric characters to underscore characters.
• Removing duplicate underscore characters.

FrontPage VBA Macro Example Code

Public Sub FixFilenames()
   Dim objWebFile As WebFile
   Dim objWebFolder As WebFolder
   Dim strOldFile As String
   Dim strNewFile As String

   If Len(Application.ActiveWeb.Title) = 0 Then
      MsgBox "A web must be open." & vbCrLf & vbCrLf & "Aborting.", vbCritical
      Exit Sub
   End If

   For Each objWebFolder In Application.ActiveWeb.AllFolders
Here:
      For Each objWebFile In objWebFolder.Files
         strOldFile = objWebFile.Name
         strNewFile = FixName(strOldFile)
         If strNewFile <> strOldFile Then
            objWebFile.Move objWebFolder.Url & "/" & strNewFile & _
               ".tmp.xyz." & objWebFile.Extension, True, False
            objWebFile.Move objWebFolder.Url & "/" & strNewFile, True, False
            GoTo Here
         End If
      Next
   Next

   MsgBox "Finished!"

End Sub

Private Function FixName(ByVal tmpOldName As String) As String
   Dim intChar As Integer
   Dim strChar As String
   Dim tmpNewName As String

   Const strValid = "1234567890_-.abcdefghijklmnopqrstuvwxyz"

   tmpOldName = LCase(tmpOldName)

   For intChar = 1 To Len(tmpOldName)
      strChar = Mid(tmpOldName, intChar, 1)
      If InStr(strValid, strChar) Then
         tmpNewName = tmpNewName & strChar
      Else
         tmpNewName = tmpNewName & "_"
      End If
   Next

   Do While InStr(tmpNewName, "__")
      tmpNewName = Replace(tmpNewName, "__", "_")
   Loop

   Do While InStr(tmpNewName, "_-_")
      tmpNewName = Replace(tmpNewName, "_-_", "_")
   Loop

   FixName = tmpNewName

End Function