'Reads image, audio, and text files and creates an HTM slideshow. 'Released to Public Domain by Eric Phelps 2005 'http://www.ericphelps.com Option Explicit Main Sub Main() Dim strTextExtension, strTextPath, strTextFile Dim strPictureExtensions, strPictureExtension Dim strPicturePath, strBigPicturePath, strBigPictureFile, strBigPictureUrl Dim strPictureUrlPath, strBigPictureUrlPath, strPictureUrl, strPictureFile Dim strSoundExtensions, strSoundExtension, strSoundPath, strSoundUrlPath, strSoundUrl, strSoundFile Dim strHtmSuffix, strHtmPath, strHtmFile, strHtmName Dim strTitle, strContent, strBaseName Dim strFirst, strLast, strHome, strPrevious, strNext Dim strDefault, strPrompt Dim blnZero, blnAcceptDefaults Dim intCount Dim fs, fol, fils, fil, list() Set fs = CreateObject("Scripting.FileSystemObject") 'If we got a good argument, see if user will accept all defaults. blnAcceptDefaults = False If WScript.Arguments.Count = 1 Then strHtmPath = WScript.Arguments(0) If fs.FileExists(strHtmPath) Then strHtmPath = fs.GetParentFolderName(strHtmPath) End If If fs.FolderExists(strHtmPath) Then blnAcceptDefaults = MsgBox("Accept defaults? If you've used this script before and you know the automatic choices will work for you, choose ""Yes"". Otherwise choose ""No"" to be given the opportunity to make custom choices.", vbYesNo, "Accept Defaults") = vbYes End If End If 'HTM extension strDefault = ".htm" If blnAcceptDefaults Then strHtmSuffix = strDefault Else strPrompt = "HTM web pages will be created for each slide. Enter the HTM web page suffix here:" strHtmSuffix = InputBox(strPrompt, "HTM Page Suffix", strDefault) strHtmSuffix = Trim(strHtmSuffix) If strHtmSuffix = "" Then strHtmSuffix = strDefault End If 'HTM destination If WScript.Arguments.Count = 1 Then strHtmPath = WScript.Arguments(0) If fs.FileExists(strHtmPath) Then strHtmPath = fs.GetParentFolderName(strHtmPath) End If If Not fs.FolderExists(strHtmPath) Then strHtmPath = fs.GetFolder(".").Path End If Else strHtmPath = fs.GetFolder(".").Path End If strDefault = strHtmPath If blnAcceptDefaults Then strHtmPath = strDefault Else strPrompt = "Create content HTM web pages where: Cancel =" & vbCrLf & """" & strDefault & """" strHtmPath = BrowseForFolder(strPrompt) If strHtmPath = "" Then strHtmPath = strDefault End If 'Text source strDefault = strHtmPath If blnAcceptDefaults Then strTextPath = strDefault Else strPrompt = "Existing text files (if any) location: Cancel =" & vbCrLf & """" & strDefault & """" strTextPath = BrowseForFolder(strPrompt) If strTextPath = "" Then strTextPath = strDefault End If 'Text extensions strDefault = ".txt" If blnAcceptDefaults Then strTextExtension = strDefault Else strPrompt = "Existing text file extension:" strTextExtension = InputBox(strPrompt, "Text File Extension", strDefault) If Trim(strTextExtension) = "" Then strTextExtension = strDefault End If 'Picture extensions strDefault = ".png, .jpg, .jpeg, .gif, .bmp" If blnAcceptDefaults Then strPictureExtensions = strDefault Else strPrompt = "Existing picture file extensions (comma delimited string):" strPictureExtensions = InputBox(strPrompt, "Picture File Types", strDefault) If Trim(strPictureExtensions = "") Then strPictureExtensions = strDefault End If 'Picture source strDefault = strTextPath If blnAcceptDefaults Then strPicturePath = strDefault Else strPrompt = "Existing WEB-SIZE picture files (if any) location: Cancel =" & vbCrLf & """" & strDefault & """" strPicturePath = BrowseForFolder(strPrompt) If strPicturePath = "" Then strPicturePath = strDefault End If 'Picture URL strDefault = RelativePath(strHtmPath, strPicturePath) If strDefault = "" Then strDefault = "./" If blnAcceptDefaults Then strPictureUrlPath = strDefault Else strPrompt = "What (if any) directory information should preceed each WEB picture file so that it can be located from the HTM file?" strPictureUrlPath = InputBox(strPrompt, "Picture URL Path", strDefault) End If If strPictureUrlPath <> "" Then If Right(strPictureUrlPath, 1) <> "/" Then strPictureUrlPath = strPictureUrlPath & "/" End If 'Big picture source strDefault = strPicturePath 'Left(strTextPath, InStrRev(strTextPath, "\") - 1) If blnAcceptDefaults Then strBigPicturePath = strDefault Else strPrompt = "Existing FULL-SIZE picture files (if any) location: Cancel =" & vbCrLf & """" & strDefault & """" strBigPicturePath = BrowseForFolder(strPrompt) If strBigPicturePath = "" Then strBigPicturePath = strDefault End If 'Big Picture URL strDefault = RelativePath(strHtmPath, strBigPicturePath) If strDefault = "" Then strDefault = "./" If blnAcceptDefaults Then strBigPictureUrlPath = strDefault Else strPrompt = "What (if any) directory information should preceed each FULL SIZE picture file so that it can be located from the HTM file?" strBigPictureUrlPath = InputBox(strPrompt, "Picture URL Path", strDefault) End If If strBigPictureUrlPath <> "" Then If Right(strBigPictureUrlPath, 1) <> "/" Then strBigPictureUrlPath = strBigPictureUrlPath & "/" End If 'Sound source strDefault = strTextPath If blnAcceptDefaults Then strSoundPath = strDefault Else strPrompt = "Existing sound files (if any) location: Cancel =" & vbCrLf & """" & strDefault & """" strSoundPath = BrowseForFolder(strPrompt) If strSoundPath = "" Then strSoundPath = strDefault End If 'Sound extensions strDefault = ".wma, .asf, .wav, .mp3, .mid, .au" If blnAcceptDefaults Then strSoundExtensions = strDefault Else strPrompt = "Existing sound file extensions (comma delimited string):" strSoundExtensions = InputBox(strPrompt, "Sound File Types", strDefault) If Trim(strSoundExtensions = "") Then strSoundExtensions = strDefault End If 'Sound URL strDefault = RelativePath(strHtmPath, strSoundPath) If strDefault = "" Then strDefault = "./" If blnAcceptDefaults Then strSoundUrlPath = strDefault Else strPrompt = "What (if any) directory information should preceed each sound file so that it can be located from the HTM file?" strSoundUrlPath = InputBox(strPrompt, "Sound URL Path", strDefault) End If If strSoundUrlPath <> "" Then If Right(strSoundUrlPath, 1) <> "/" Then strSoundUrlPath = strSoundUrlPath & "/" End If 'Get the title If ((Len(fs.GetBaseName(strHtmPath)) > 2) And (Instr(fs.GetBaseName(strHtmPath), " ") = 0)) Then strDefault = Left(fs.GetBaseName(strHtmPath), 1) For intCount = 2 To Len(fs.GetBaseName(strHtmPath)) If InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid(fs.GetBaseName(strHtmPath), intCount, 1)) <> 0 Then strDefault = strDefault & " " & Mid(fs.GetBaseName(strHtmPath), intCount, 1) Else strDefault = strDefault & Mid(fs.GetBaseName(strHtmPath), intCount, 1) End If Next Else strDefault = fs.GetBaseName(strHtmPath) End If If blnAcceptDefaults Then strTitle = strDefault Else strPrompt = "Enter the ""title"" of this presentation" strTitle = InputBox(strPrompt, "Title", strDefault) If Trim(strTitle) = "" Then strTitle = strDefault End If 'Create a "master" list of the defining file: picture, text, or audio (in that order) 'Check all files in the picture directory Set fol = fs.GetFolder(strPicturePath) Set fils = fol.Files ReDim list(0) blnZero = True Status "Reading picture file names..." For Each fil In fils For Each strPictureExtension In Split(strPictureExtensions, ",") strPictureExtension = Trim(strPictureExtension) If Left(strPictureExtension, 1) <> "." Then strPictureExtension = "." & strPictureExtension If Lcase(Right(fil.Name, Len(Trim(strPictureExtension)))) = Lcase(Trim(strPictureExtension)) Then 'It's a picture. Add it to our list Status vbTab & fil.Name If Not blnZero Then ReDim Preserve list(UBound(list) + 1) blnZero = False list(UBound(list)) = fil.name Exit For End If Next Next 'Check text directory Set fol = fs.GetFolder(strTextPath) Set fils = fol.Files If Left(strTextExtension, 1) <> "." Then strTextExtension = "." & strTextExtension Status "Reading text file names..." For Each fil In fils If Lcase(Right(fil.Name, Len(Trim(strTextExtension)))) = Lcase(Trim(strTextExtension)) Then 'It's text. Status vbTab & fil.Name If Not BaseNameInArray(list, fil.Name) Then 'There's no picture by that name; add the text file to the list If Not blnZero Then ReDim Preserve list(UBound(list) + 1) blnZero = False list(UBound(list)) = fil.name End If End If Next 'Check sound directory Set fol = fs.GetFolder(strSoundPath) Set fils = fol.Files Status "Reading sound file names..." For Each fil In fils For Each strSoundExtension In Split(strSoundExtensions, ",") strSoundExtension = Trim(strSoundExtension) If Left(strSoundExtension, 1) <> "." Then strSoundExtension = "." & strSoundExtension If Lcase(Right(fil.Name, Len(Trim(strSoundExtension)))) = Lcase(Trim(strSoundExtension)) Then 'It's sound. Status vbTab & fil.Name If Not BaseNameInArray(list, fil.Name) Then 'There's no picture or text by that name; add the sound file to the list If Not blnZero Then ReDim Preserve list(UBound(list) + 1) blnZero = False list(UBound(list)) = fil.name Exit For End If End If Next Next 'Sort the list Status "Sorting names..." SortAscending list, "*", 0 'Get the wrap and home choices If blnAcceptDefaults Then strHome = "../" strFirst = strHome strLast = strHome Else Status "Getting HOME preference..." strPrompt = "During the presentation, if the user presses the ""Home"" button, what should happen?" strPrompt = strPrompt & vbCrLf & "1 - Go up one folder" strPrompt = strPrompt & vbCrLf & "2 - Go to the first slide" strPrompt = strPrompt & vbCrLf & "(Enter a number or a URL)" strDefault = "1" strHome = InputBox(strPrompt, "Home", strDefault) strHome = Trim(strHome) If strHome = "" Then strHome = strDefault Select Case Left(strHome, 1) Case "1" strHome = "../" Case "2" strHome = fs.GetBaseName(list(LBound(list))) & strHtmSuffix Case Else 'Do Nothing. Accept whatever the end-user entered. End Select Status "Getting FIRST preference..." strDefault = "1" strPrompt = "If the user is on the FIRST slide and presses the ""Back"" button, what should happen?" strPrompt = strPrompt & vbCrLf & "1 - Same thing as pressing ""Home""" strPrompt = strPrompt & vbCrLf & "2 - Stay at the first slide" strPrompt = strPrompt & vbCrLf & "3 - Wrap to the last slide" strFirst = InputBox(strPrompt, "Back", strDefault) strFirst = Trim(strFirst) If strFirst = "" Then strFirst = strDefault Select Case Left(strFirst, 1) Case "1" strFirst = strHome Case "2" strFirst = fs.GetBaseName(list(LBound(list))) & strHtmSuffix Case "3" strFirst = fs.GetBaseName(list(UBound(list))) & strHtmSuffix Case Else strFirst = strHome End Select Status "Getting LAST preference..." strDefault = "1" strPrompt = "If the user is on the LAST slide and presses the ""Next"" button, what should happen?" strPrompt = strPrompt & vbCrLf & "1 - Same thing as pressing ""Home""" strPrompt = strPrompt & vbCrLf & "2 - Stay at the last slide" strPrompt = strPrompt & vbCrLf & "3 - Wrap to the first slide" strLast = InputBox(strPrompt, "Next", strDefault) strLast = Trim(strLast) If strLast = "" Then strLast = strDefault Select Case Left(strLast, 1) Case "1" strLast = strHome Case "2" strLast = fs.GetBaseName(list(UBound(list))) & strHtmSuffix Case "3" strLast = fs.GetBaseName(list(LBound(list))) & strHtmSuffix Case Else strLast = strHome End Select End If 'Confirm If Not blnAcceptDefaults Then Status "Confirming permission to create files..." If MsgBox("Last question! Build the HTM files for a presentation?", vbOkCancel, "Proceed?") = vbCancel Then Exit Sub End If End If Status "Creating files..." 'Create the content For intCount = LBound(list) To UBound(list) strBaseName = fs.GetBaseName(list(intCount)) 'Get the file name of the text file strTextFile = FileNameIfExists(strBaseName, strTextExtension, strTextPath) If strTextFile <> "" Then strTextFile = fs.BuildPath(strTextPath, strTextFile) End If 'Get the URL for the picture strPictureFile = FileNameIfExists(strBaseName, strPictureExtensions, strPicturePath) If strPictureFile = "" Then strPictureUrl = "" Else strPictureUrl = strPictureUrlPath & strPictureFile End If 'Get the URL for the BIG picture strBigPictureFile = FileNameIfExists(strBaseName, strPictureExtensions, strBigPicturePath) If strBigPictureFile = "" Then strBigPictureUrl = "" Else strBigPictureUrl = strBigPictureUrlPath & strPictureFile End If 'Get the URL for the sound strSoundFile = FileNameIfExists(strBaseName, strSoundExtensions, strSoundPath) If strSoundFile = "" Then strSoundUrl = "" Else strSoundUrl = strSoundUrlPath & strSoundFile End If 'Get the name of the HTM file we'll be constructing strHtmName = fs.BuildPath(strHtmPath, strBaseName & strHtmSuffix) 'Get the Previous URL for navigation purposes If intCount = LBound(list) Then strPrevious = strFirst Else strPrevious = fs.GetBaseName(list(intCount - 1)) & strHtmSuffix End If 'Get the Next URL for navigation purposes If intCount = UBound(list) Then strNext = strLast Else strNext = fs.GetBaseName(list(intCount + 1)) & strHtmSuffix End If strContent = "" strContent = strContent & vbCrLf & "" & strTitle & "" strContent = strContent & vbCrLf & "" strContent = strContent & vbCrLf & "" strContent = strContent & vbCrLf & "" strContent = strContent & vbCrLf & "" strContent = strContent & vbCrLf & "" strContent = strContent & vbCrLf & "" strContent = strContent & vbCrLf & "
" & NavCode(strPrevious, strHome, strNext) & "" & PlayerCode(strSoundUrl) & "
" strContent = strContent & vbCrLf & ContentCode(strTextFile, strPictureUrl, strBigPictureUrl) strContent = strContent & vbCrLf & "" strContent = strContent & vbCrLf & "" String2File strContent, strHtmName Next MsgBox "Files have been created. Your first page should be """ & fs.GetBaseName(list(LBound(list))) & strHtmSuffix & """." End Sub Function MatchesExtension(strFileName, strExtensions) Dim strExtension, blnMatchesExtension blnMatchesExtension = False For Each strExtension In Split(strExtensions, ",") If Left(strExtension, 1) <> "." Then strExtension = "." & strExtension If Lcase(Right(strFileName, Len(Trim(strExtension)))) = Lcase(Trim(strExtension)) Then blnMatchesExtension = True Exit For End If Next MatchesExtension = blnMatchesExtension End Function Function FileNameIfExists(strBaseName, strExtensions, strPath) Dim fs, fol, fils, fil, strExtension, intCount Set fs = CreateObject("Scripting.FileSystemObject") For Each strExtension In Split(strExtensions, ",") strExtension = Trim(strExtension) If Left(strExtension, 1) <> "." Then strExtension = "." & strExtension If fs.FileExists(fs.BuildPath(strPath, strBaseName & strExtension)) Then FileNameIfExists = fs.GetFile(fs.BuildPath(strPath, strBaseName & strExtension)).Name Exit Function End If Next FileNameIfExists = "" End Function Function BaseNameInArray(varArray, strFileName) Dim fs, strElement, strBase, blnInArray Set fs = CreateObject("Scripting.FileSystemObject") blnInArray = False strBase = Lcase(fs.GetBaseName(strFileName)) For Each strElement In varArray If Lcase(fs.GetBaseName(strElement)) = strBase Then blnInArray = True Exit For End If Next BaseNameInArray = blnInArray End Function Sub AppendToFile(strFile, strText) Dim fs 'As Scripting.FileSystemObject Dim ts 'As Scripting.TextStream Const ForAppending = 8 Set fs = CreateObject("Scripting.FileSystemObject") Set ts = fs.OpenTextFile(strFile, ForAppending, True) ts.Write strText ts.Close End Sub Sub SortAscending(strArray, strSplitCharacter, intSortByElement) Dim blnChanged 'As Boolean Dim strBuffer 'As String Dim intCounter 'As Integer blnChanged = True Do Until Not blnChanged blnChanged = False For intCounter = Lbound(strArray) + 1 to Ubound(strArray) If Split(strArray(intCounter -1), strSplitCharacter)(intSortByElement) > Split(strArray(intCounter), strSplitCharacter)(intSortByElement) Then blnChanged = True strBuffer = strArray(intCounter -1) strArray(intCounter -1) = strArray(intCounter) strArray(intCounter) = strBuffer End If Next Loop End Sub Sub String2File(strData, strFileName) 'Writes a string to a file Dim fs 'As Scripting.FileSystemObject Dim ts 'As Scripting.TextStream Dim lngChar, strBlock, intChar Const ForWriting = 2 Set fs = CreateObject("Scripting.FileSystemObject") Set ts = fs.OpenTextFile(strFileName, ForWriting, True) Err.Clear On Error Resume Next ts.Write strData If Err.Number <> 0 Then 'Must have hit one of the "problem characters" between 128 and 159 For lngChar = 1 To Len(strData) Step 100 Err.Clear ts.Write Mid(strData, lngChar, 100) If Err.Number <> 0 Then 'This block of 100 must have the problem. Write them one-at-a-time strBlock = Mid(strData, lngChar, 100) For intChar = 1 To Len(strBlock) ts.Write Chr(255 And AscW(Mid(strBlock, intChar))) Next End If Next End If ts.Close End Sub Function File2String(strFile) 'As String Dim fs 'As Scripting.FileSystemObject Dim ts 'As Scripting.TextStream Const ForReading = 1 Set fs = CreateObject("Scripting.FileSystemObject") If fs.FileExists(strFile) Then Set ts = fs.OpenTextFile(strFile, ForReading, True) If ts.AtEndOfStream Then File2String ="" Else File2String = ts.ReadAll End If ts.Close Else File2String = "" End If End Function Function FileNameLikeMine(strFileExtension) 'As String 'Returns a file name the same as the script name except 'for the file extension. Dim fs 'As Object Dim strExtension 'As String Set fs = CreateObject("Scripting.FileSystemObject") strExtension = strFileExtension If Len(strExtension) < 1 Then strExtension = "txt" If strExtension = "." Then strExtension = "txt" If Left(strExtension,1) = "." Then strExtension = Mid(strExtension, 2) FileNameLikeMine = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & strExtension End Function Function Text2Html(strRawData) 'As String 'Makes raw text safe to display on a web page Dim strText2Html 'As String strText2Html = strRawData strText2Html = Replace(strText2Html, "<", "<") strText2Html = Replace(strText2Html, ">", ">") strText2Html = Replace(strText2Html, "&", "&") strText2Html = Replace(strText2Html, vbCrLf & vbCrLf, vbCrLf & "

" & vbCrLf) strText2Html = Replace(strText2Html, vbCr & vbCr, vbCrLf & "

" & vbCrLf) strText2Html = Replace(strText2Html, vbLf & vbLf, vbCrLf & "

" & vbCrLf) strText2Html = Replace(strText2Html, vbTab, "    ") strText2Html = Replace(strText2Html, " ", "  ") Text2Html = strText2Html End Function Sub Status (strMessage) If Lcase(Right(Wscript.FullName, 12)) = "\cscript.exe" Then Wscript.Echo strMessage End If End Sub Function BrowseForFolder(strPrompt) 'Uses the "Shell.Application" (only present in Win98 and newer) 'to bring up a file/folder selection window. Falls back to an 'ugly input box under Win95. 'Shell32.ShellSpecialFolderConstants Const ssfPERSONAL = 5 'My Documents Const ssfDRIVES = 17 'My Computer Const SFVVO_SHOWALLOBJECTS = 1 Const SFVVO_SHOWEXTENSIONS = 2 Dim sh, fol, fs, lngView, strPath Set sh = CreateObject("Shell.Application") If Instr(TypeName(sh), "Shell") = 0 Then BrowseForFolder = InputBox(strPrompt, "Select Folder", CreateObject("Scripting.FileSystemObject").GetParentFolderName(WScript.ScriptFullName)) Exit Function End If Set fs = CreateObject("Scripting.FileSystemObject") lngView = SFVVO_SHOWALLOBJECTS Or SFVVO_SHOWEXTENSIONS strPath = "" Set fol = sh.BrowseForFolder(&0, strPrompt, lngView, ssfDRIVES) Err.Clear On Error Resume Next strPath = fol.ParentFolder.ParseName(fol.Title).Path 'An error occurs if the user selects a drive instead of a folder If Err.Number <> 0 Then BrowseForFolder = Left(Right(fol.Title, 3), 2) & "\" Else BrowseForFolder = strPath End If End Function Function RelativePath(strFrom, strTo) 'Returns a string containing a URL-relative path 'between the two folders or files. For example, if 'strFrom was "C:\a\b\c\d\e" and strTo was "C:\a\b\x\y", 'then the result would be "../../../x/y/" Dim intEnd, intCount, strRelativePath, strFromPath, strToPath Dim fs Set fs = CreateObject("Scripting.FileSystemObject") 'Preserve input variables strFromPath = strFrom strToPath = strTo 'Append a slash to folders (assuming we are doing local stuff) If Right(strFromPath, 1) <> "\" Then If fs.FolderExists(strFromPath) Then strFromPath = strFromPath & "\" End If If Right(strToPath, 1) <> "\" Then If fs.FolderExists(strToPath) Then strToPath = strToPath & "\" End If 'To see how much the paths have in common, we see which is shortest If Len(strFromPath) > Len(strToPath) Then intEnd = Len(strToPath) Else intEnd = Len(strFromPath) End If 'Find the common path For intCount = 1 To intEnd If Mid(strFromPath, intCount, 1) <> Mid(strToPath, intCount, 1) Then Exit For Next If intCount = 1 Then 'The first character is different: They are on different drives? Give up! RelativePath = "" Exit Function End If 'Replace the slashes strFromPath = Replace(strFromPath, "\", "/") strToPath = Replace(strToPath, "\", "/") 'Back up the common counter to the nearest slash intCount = InStrRev(Left(strToPath, intCount), "/") + 1 'Trim the paths strFromPath = Mid(strFromPath, intCount) strToPath = Mid(strToPath, intCount) 'Start with the strToPath as the base for the relative path strRelativePath = Replace(strToPath, " ", "%20") 'Walk up a level for every directory in strFromPath For intCount = 1 To Len(strFromPath) If Mid(strFromPath, intCount, 1) = "/" Then strRelativePath = "../" & strRelativePath Next RelativePath = strRelativePath End Function Function PlayerCode(strAudioUrl) Dim strBuffer If strAudioUrl = "" Then strBuffer = " " Else strBuffer = "" strBuffer = strBuffer & vbCrLf & "" strBuffer = strBuffer & vbCrLf & " " strBuffer = strBuffer & vbCrLf & " " strBuffer = strBuffer & vbCrLf & " " strBuffer = strBuffer & vbCrLf & " " strBuffer = strBuffer & vbCrLf & "" End If PlayerCode = strBuffer End Function Function NavCode(strPrevious, strHome, strNext) Dim strBuffer strBuffer = "" strBuffer = strBuffer & vbCrLf & " " strBuffer = strBuffer & vbCrLf & " " strBuffer = strBuffer & vbCrLf & " " strBuffer = strBuffer & "" NavCode = strBuffer End Function Function ContentCode(strTextFilePath, strPictureUrl, strBigPictureUrl) Dim strBuffer strBuffer = "" If strPictureUrl <> "" Then strBuffer = strBuffer & vbCrLf If strBigPictureUrl <> "" Then strBuffer = strBuffer & "" End If strBuffer = strBuffer & " "" Then strBuffer = strBuffer & "border=""0"">" Else strBuffer = strBuffer & ">" End If End If If ((strPictureUrl <> "") And (strTextFilePath <> "")) Then strBuffer = strBuffer & vbCrLf & "
" 'strBuffer = strBuffer & vbCrLf & "
" 'strBuffer = strBuffer & vbCrLf & "" End If If strTextFilePath <> "" Then strBuffer = strBuffer & vbCrLf & Text2Html(File2String(strTextFilePath)) End If ContentCode = strBuffer End Function