Dim pCurrentDir, pFilename, ObjFSO, objIP, objWord, objDir, objDoc, x, objFile, objSubDir, strTargetFile
 
Const wdFormatPDF = 17
 
' Change the path below to the folder that you want to convert to PDF
'##############################################################
 
strInDir  = InputBox("Please enter the InfoPath document folder.") 
 
strOutDir = InputBox("Please enter the DESTINATION folder for the PDF files.")
 
'##############################################################
 
'initialize objects: Filesystem, Infopath, Word
 
Set objFSO  = CreateObject("Scripting.FileSystemObject")
Set objIP   = CreateObject("InfoPath.Application")
Set objWord = CreateObject("Word.Application")
Set objDir  = objFSO.GetFolder(strInDir)
 
' this does all the work
getXMLFiles(objDir)
 
objIP.Quit(true)
objWord.Quit
 
'##############################################################
Function getXMLFiles(pCurrentDir)
 
   For Each objFile In pCurrentDir.Files
      pFilename = objFile.Name
      strTargetFile = replace(pCurrentDir, strInDir, strOutDir) & "\" & objFSO.GetBaseName(pFilename) & ".PDF"
      strSourceFile = pCurrentDir & "\" & pFilename
      If Not objFSO.FolderExists(replace(pCurrentDir, strInDir, strOutDir)) Then
         x = objFSO.CreateFolder(replace(pCurrentDir, strInDir, strOutDir))
      End If
 
 
      If LCase(Right(Cstr(objFile.Name), 3)) = "xml" Then
         'x = MakePDF(pCurrentDir, pFilename, "I") ' InfoPath
         objIP.XDocuments.Open(strSourceFile)
         x = objIP.XDocuments.Item(0).View.Export(strTargetFile, "PDF")
         objIP.XDocuments.Close(0)
      Else
         'x = MakePDF(pCurrentDir, pFilename, "W") ' Word
         objWord.Documents.Open strSourceFile
         Set objDoc = objWord.ActiveDocument
         objDoc.SaveAs strTargetFile, wdFormatPDF
         objDoc.Close
      End If
 
      ' wscript.Echo strSourceFile, "->", strTargetFile
 
   Next
 
   For Each objSubDir In pCurrentDir.SubFolders
      'wscript.Echo objSubDir.Name '& " passing recursively"
      'wscript.Echo replace(objSubDir.ParentFolder, strInDir, strOutDir) & "\" & objSubDir.Name
      getXMLFiles(objSubDir)
   Next
 
End Function
 
 
'wscript.Echo pCurrentDir
'wscript.Echo pCurrentDir.ParentFolder
'wscript.Echo objFSO.GetBaseName(pCurrentDir.ParentFolder)
'wscript.Echo objSubDir.Name
'wscript.Echo strNewDir
'strOutDir & "\" & objFSO.GetBaseName(pCurrentDir)
'wscript.Echo strNewDir