Long Filename To Short

Converts filenames in order to take less storage in the FAT

Dim A,B,C,D,E,G,i
On Error Resume Next
Function Recurs(ByVal p)
    Dim f, k, s, t
    Set f = i.GetFolder(p)
    For Each k in f.subFolders
     e = e + 1
     s = s & Recurs(k)
     t = k.ShortName
     If k.name <> t then
      If uCase(k.name)=uCase(t) Then
          i.MoveFolder k, i.BuildPath(p,t) 
          a = a + 1
      Else
          s = s & "Fld:" & k.name & vbCrLf
          b = b + 1
      End If
     End If
    Next
    For Each k in f.Files
     e = e + 1
     t = k.ShortName
     If k.name <> t then
      if uCase(k.name)=uCase(t) Then
          i.MoveFile k, i.BuildPath(p, t)
          c = c + 1
      Else
          s = s & "File:" & k.name & vbCrLf
          d = d + 1
      End If
     End If
    Next
    Recurs = s
End Function

If 1=MsgBox("This script converts long filenames and foldernames to short one " & _
	"in order to need less storage in the FAT.",1) Then
    G = InPutBox("Enter the parent directory to convert", "(c) 1998 JLA", "c:\program files")
    If G <> "" Then
     A=0
     B=0
     C=0
     D=0
     E=0
     Set i = CreateObject("Scripting.FileSystemObject")
     MsgBox "Files and directories that can't be shorten:" & vbCrLf & Recurs(G)
     MsgBox "Result for " & E & " items scanned:" & vbCrLf & A & " renamed folders" & _
		vbCrLf & B & " folders that can't be renamed" & vbCrLf & C & _
		" files renamed" & vbCrLf & D & " files that can't be renamed"
    End If
End If