Function FormatURL(strPath) 'Cut off everything before wwwroot and replace all \ with / Dim iPos iPos = InStr(1,strPath,"wwwroot",1) Dim str str = Mid(strPath,iPos+7,Len(strPath)) FormatURL = Replace(str,"\","/") End Function Function addarticles(objFolder) If Left(objFolder.Name,1) = "_" then exit function 'Now, loop through each file Dim objFile, objTextStream, objFSO, strContents, iUBound, iLoop, bolValid Dim strTitle, iPos, strDesc For Each objFile in objFolder.Files 'Do we need to search this file? If UCase(Right(objFile.Name,6)) = ".SHTML" or UCase(right(objFile.Name,4)) = ".ASP" then if objFile.Size > 0 then Set objFSO = CreateObject("Scripting.FileSystemObject") Set objTextStream = objFSO.OpenTextFile(objFile.Path,1) strContents = objTextStream.ReadAll objTextStream.Close Set objTextStream = Nothing Set objFSO = Nothing iPos = InStr(1,strContents,"<!--TITLE:") If iPos = 0 then strTitle = "Untitled (" & objFile.Name & ")" strDesc = "" Else strTitle = Mid(strContents,iPos+10,InStr(iPos,strContents,"-->")-iPos-10) iPos = InStr(iPos,strContents,"<!--DESC:") If iPos = 0 then strDesc = "" Else strDesc = Mid(strContents,iPos+9,InStr(iPos,strContents,"-->")-iPos-9) End If End If if len(strTitle) > 150 then strTitle = Left(strTitle,140) & "..." if len(strDesc) >= 254 then strDesc = Left(strDesc,245) & "..." objRS.AddNew objRS("Title") = strTitle objRS("Description") = strDesc objRS("Contents") = strContents objRS("Url") = FormatURL(objFile.Path) objRS.Update End If End if Next Dim objSubFolder For Each objSubFolder in objFolder.SubFolders AddArticles objSubFolder Next End Function Dim objFSO Set objFSO = CreateObject("Scripting.FileSystemObject") DIm objFolder Set objFolder = objFSO.GetFolder("D:\Inetpub\wwwroot\webtech") Dim objConn Set objConn = CreateObject("ADODB.Connection") objConn.Open "DSN=4guys" 'Clean out AritlceIndex objCOnn.Execute "DELETE FROM tblArticleIndex" Dim objRS Set objRS = CreateObject("ADODB.Recordset") objRS.Open "ArticleIndex",objConn,3,3,2 AddArticles objFolder objRS.Close Set objRS = Nothing Set objFolder = Nothing objConn.Close Set objConn = Nothing Set objFSO = Nothing