Private Sub Command1_Click() Dim objApp As New Illustrator.Application Dim objExportOptions As New Illustrator.ExportOptionsJPEG Dim objFileSys As New FileSystemObject Dim objFile As TextStream Dim objFiles As Files Dim objFolder As Folder Dim objFolderGall As Folder Dim objFolderImg As Folder Dim objFolderPage As Folder Dim objFolderThumb As Folder Dim theFiles As Files Dim f1 As File Dim myName As String Dim myPath As String Dim htmlFrame As String Dim htmlPage As String Dim htmlIndex As String Dim htmlIndexRows As String Dim success As Boolean 'walk selected folder, looking for AI and PDF docs If Dir1.Path <> "" Then 'make new folders for images and html Set objFolder = objFileSys.GetFolder(Dir1.Path) Set objFolderGall = objFolder.SubFolders.Add("gallery") Set objFolderImg = objFolderGall.SubFolders.Add("images") Set objFolderPage = objFolderGall.SubFolders.Add("pages") Set objFolderThumb = objFolderGall.SubFolders.Add("thumbnails") 'reserved characters (can't be in filenames processed) ' ^ (repeating index rows) ' ~ (image number) 'standard frameset html htmlFrame = "" htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "Web Gallery" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "<BODY>" & vbCrLf htmlFrame = htmlFrame & "Viewing this page requires a browser capable of displaying frames." & vbCrLf htmlFrame = htmlFrame & "</BODY>" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf htmlFrame = htmlFrame & "" & vbCrLf 'write frameset Set objFile = objFileSys.CreateTextFile(objFolderGall.Path & "\" & "frameset.html", True, False) objFile.Write htmlFrame objFile.Close 'standard thumb index html htmlIndex = "" htmlIndex = htmlIndex & "" & vbCrLf htmlIndex = htmlIndex & "" & vbCrLf htmlIndex = htmlIndex & "Web Gallery" & vbCrLf htmlIndex = htmlIndex & "" & vbCrLf htmlIndex = htmlIndex & "" & vbCrLf htmlIndex = htmlIndex & "" & vbCrLf htmlIndex = htmlIndex & "" & vbCrLf htmlIndex = htmlIndex & "" & vbCrLf htmlIndex = htmlIndex & "

" & vbCrLf htmlIndex = htmlIndex & "^" & vbCrLf 'repeating row htmlIndexRow = "" htmlIndexRow = htmlIndexRow & "" & vbCrLf ' htmlIndex = htmlIndex & "
" & vbCrLf htmlIndexRow = htmlIndexRow & "

1
" & vbCrLf htmlIndexRow = htmlIndexRow & "~.jpg" & vbCrLf htmlIndexRow = htmlIndexRow & "

" & vbCrLf htmlIndex = htmlIndex & "" & vbCrLf htmlIndex = htmlIndex & "" & vbCrLf 'clear running string for final insertion htmlIndexRows = "" 'standard image page html htmlPage = "" htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "~" & vbCrLf htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "" & vbCrLf htmlPage = htmlPage & "
Web Gallery / ~

" & Date & "
" & vbCrLf htmlPage = htmlPage & "
" & vbCrLf htmlPage = htmlPage & "

1

" & vbCrLf htmlPage = htmlPage & "" & vbCrLf 'loop thru all files that Illustrator can open Set theFiles = objFolder.Files Dim i As Long i = 0 For Each f1 In theFiles i = i + 1 myPath = f1.Path 'open document in illustrator objApp.Open (myPath) If objApp.Documents.Count > 0 Then objExportOptions.HorizontalScale = 20 objExportOptions.VerticalScale = 20 objApp.Documents(1).Export objFolderThumb.Path & "\" & i & ".jpg", aiJPEG, objExportOptions objExportOptions.HorizontalScale = 75 objExportOptions.VerticalScale = 75 objApp.Documents(1).Export objFolderImg.Path & "\" & i & ".jpg", aiJPEG, objExportOptions objApp.Documents(1).Close (AiSaveOptions.aiDoNotSaveChanges) htmlIndexRows = htmlIndexRows & Replace(htmlIndexRow, "~", i) 'and creating a page html file Set objFile = objFileSys.CreateTextFile(objFolderPage.Path & "\" & i & ".html", True, False) objFile.Write Replace(htmlPage, "~", i) objFile.Close End If Next 'save thumbnail index htmlIndex = Replace(htmlIndex, "^", htmlIndexRows) Set objFile = objFileSys.CreateTextFile(objFolderGall.Path & "\" & "index.html", True, False) objFile.Write Replace(htmlIndex, "~", i) objFile.Close End If End Sub