'■■■ Main Script ■■■ Public objFileSystem Private objShell,objShFolder Private sRet Private nRet Set objShell = CreateObject("Shell.Application") ' Function BrowseForFolder( _ ' HWND As Long, _ ' Title As String, _ ' Options As Long, _ ' [RootFolder]) As Folder Set objShFolder = objShell.BrowseForFolder(0, "アルバム化を行うフォルダの選択", 1) If Not objShFolder Is Nothing Then sRet = objShFolder.Items.Item.Path sRetname =objShFolder.Items.Item.Name Set objFileSystem = CreateObject("Scripting.FileSystemObject") If Right(sRet,1) <> "\" Then sRet = sRet & "\" On Error Resume Next If objFileSystem.FolderExists(sRet) Then nRet = MsgBox(sRet & " 内のファイルをアルバム化しますか?", _ vbOKCancel + vbInformation, _ MY_TITLE) If nRet = vbOK Then Call SetFolderFiles(sRet) Else MsgBox sRet & " フォルダが存在しません。", _ vbOKOnly + vbInformation, _ MY_TITLE End If Set objFileSystem = Nothing End If Set objShFolder = Nothing Set objShell = Nothing Set objFS = CreateObject("Scripting.FileSystemObject"): Set objFile = objFS.CreateTextFile(sRet & "album.html",true): wq=chr(34) Dim myFile Dim picFiles(500) Dim midFiles(500) Dim idxFile Dim strName pic_i = 0 mid_i = 0 Set objFolder = objFS.GetFolder(sRet) For Each myFile In objFolder.Files if instr(myFile.Name,".jpg")>0 or instr(myFile.Name,".JPE")>0 or instr(myFile.Name,".jpe")>0 or instr(myFile.Name,".JPG")>0 or instr(myFile.Name,".GIF")>0 or instr(myFile.Name,".gif")>0 then picFiles(pic_i)=myFile.Name:pic_i=pic_i+1 if instr(myFile.Name,".mid")>0 or instr(myFile.Name,".MID")>0 or instr(myFile.Name,".mp3")>0 or instr(myFile.Name,".MP3")>0 or instr(myFile.Name,".wma")>0 then midFiles(mid_i)=myFile.Name:mid_i=mid_i+1 Next picmax = pic_i-1 midmax = mid_i-1 For i = 0 To picmax For j = i To picmax if picFiles(i) > picFiles(j) then temp = picFiles(i): picFiles(i) = picFiles(j): picFiles(j) = temp Next Next objFile.WriteLine "" objFile.WriteLine "" objFile.WriteLine "" objFile.WriteLine "" objFile.WriteLine "" objFile.WriteLine "" & sRetname & "" objFile.WriteLine "" objFile.WriteLine "" objFile.WriteLine "" objFile.WriteLine "" objFile.WriteLine "
" objFile.WriteLine "
" objFile.WriteLine "" & sRetname & "  " objFile.WriteLine "" objFile.WriteLine "" objFile.WriteLine "" objFile.WriteLine "" objFile.WriteLine "  " objFile.WriteLine "  " objFile.WriteLine "
" objFile.WriteLine "" objFile.WriteLine "" objFile.close