| The Following 2 Users Say Thank You to slamp For This Useful Post: | ||
.| The Following 3 Users Say Thank You to MarkW For This Useful Post: | ||
Const OverwriteExisting = FALSE
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objBaseFolder = objFSO.GetFolder("C:\misc\GPS\CRUN12_ORIG")
Set colSubfolders = objBaseFolder.Subfolders
Dim strFilename, strLetter, varLength, strNewFileName, strNewFolderName
Dim i, x, y, z, q
'Wscript.Echo "Start"
q = 0
For Each objSubfolder in colSubfolders
'Wscript.Echo "Start 1"
Set colFiles = objSubFolder.files
For Each objFile in colFiles
x = 0
y = 0
z = 17
strFilename = objFile.Name
varLength = Len(strFilename) - 4
'Wscript.Echo "Length " & varLength
If varLength < 19 Then
For i = 1 To varLength
strLetter = Mid(strFilename,i,1)
'Wscript.Echo "Letter " & strLetter
Select Case strLetter
Case "0"
x = x * 2
y = y * 2
z = z - 1
Case "1"
x = x * 2 + 1
y = y * 2
z = z - 1
Case "2"
x = x * 2
y = y * 2 + 1
z = z - 1
Case "3"
x = x * 2 + 1
y = y * 2 + 1
z = z - 1
End Select
'Wscript.Echo "X for " & strLetter & " = " & x
'Wscript.Echo "Y for " & strLetter & " = " & y
'Wscript.Echo "Zoom " & z
Next
'Wscript.Echo "Zoom end " & z
'Wscript.Echo "X Dir " & x
strNewFolderName = "C:\misc\GPS\MM_F_CRUN\" & z
If Not objFSO.FolderExists(strNewFolderName) Then
objFSO.CreateFolder(strNewFolderName)
End If
strNewFolderName = "C:\misc\GPS\MM_F_CRUN\" & z & "\" & x
'Wscript.Echo strNewFolderName
If Not objFSO.FolderExists(strNewFolderName) Then
objFSO.CreateFolder(strNewFolderName)
End If
strNewFileName = strNewFolderName & "\" & y & ".jpg"
Set objOldFile = objFSO.GetFile(objSubfolder.Path & "\" & strFileName)
If Not objFSO.FileExists(strNewFileName) Then
objOldFile.Copy strNewFileName, OverwriteExisting
q = q + 1
End If
'Wscript.Echo strFilename & " x=" & x & " y=" & y & " z=" & z
'Wscript.Echo strNewFileName
'Wscript.Echo objBaseFolder & "\" & strFileName
End If
Next
Next
Wscript.Echo q & " Tiles copied"