Option Explicit
 
'declare all variables
Dim objWord
Dim oDoc
Dim fso
Dim colFiles
Dim curFile
Dim curFileName
Dim folderToScan
Dim folderToSave
Dim subfolderToSave
Dim fileToSave
Dim folderToScanExists
Dim folderToSaveExists
Dim objFolderToScan

'set some of the variables
folderToScanExists = False
folderToSaveExists = False
Const wdSaveFormat = 10 'for Filtered HTML output
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
'**********************************
'change the following to fit your system
folderToScan = fso.GetAbsolutePathName(".") & "\"
folderToSave = fso.GetAbsolutePathName(".") & "\"
'**********************************
 
'Use FSO to see if the folders to read from
'and write to both exist.
'If they do, then set both flags to TRUE,
'and proceed with the function
If fso.FolderExists(folderToScan) Then
  folderToScanExists = True
Else
  Wscript.Echo "Folder to scan from does not exist!"
End If
If fso.FolderExists(folderToSave) Then
  folderToSaveExists = True
Else
  Wscript.Echo "Folder to copy to does not exist!"
End If
 
If (True Or folderToScanExists And folderToSaveExists) Then
  'get your folder to scan
  Set objFolderToScan = fso.GetFolder(folderToScan)
  'put al the files under it in a collection
  Set colFiles = objFolderToScan.Files
  'create an instance of Word
  Set objWord = CreateObject("Word.Application")
  If objWord Is Nothing Then
    Wscript.Echo "Couldn't start Word."
  Else
    'for each file
    For Each curFile in colFiles
      'only if the file is of type DOC
      If (fso.GetExtensionName(curFile) = "doc" Or (fso.GetExtensionName(curFile) = "docx")) Then
        'get the filename without extension
        curFileName = curFile.Name
        curFileName = Mid(curFileName, 1, InStrRev(curFileName, ".") - 1)
        subfolderToSave = folderToSave & "\" & curFileName
        fso.CreateFolder subfolderToSave
        'open the file inside Word
        objWord.Documents.Open fso.GetAbsolutePathName(curFile)
        'do all this in the background
        objWord.Visible = False
        'create a new document and save it as Filtered HTML
        fileToSave = subfolderToSave & "\webfiles.htm"
        Set oDoc = objWord.ActiveDocument
        oDoc.SaveAs fileToSave, wdSaveFormat
        oDoc.Close
        Set oDoc = Nothing
        fso.MoveFile fileToSave, subfolderToSave & "\task.htm"
      End If
    Next
  End If
  'close Word
  objWord.Quit
  'set all objects and collections to nothing
  Set objWord = Nothing
  Set colFiles = Nothing
  Set objFolderToScan = Nothing
End If
 
Set fso = Nothing

cscript //D //X createHtmlFromWord.vbs