'
On Error Resume Next
'convert CVS file to XML format
Dim objFSO
dim objXML
Dim objRoot
Dim objNode
Dim objAttrib
Dim objChildNode
Dim objConnection, objRecordset,objFields
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
strSource=OpenFilePath() 'You must return a full filename and path for the source CSV file.
strXMLFile=SaveAs("demo.xml") 'Specify the name of the XML file to create.
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")
Set objFSO=CreateObject("Scripting.FileSystemObject")
'verify csv file exists just in case someone manually typed in a filename and path.
If objFSO.FileExists(strSource) Then
tmpArray=Split(GetFilePath(strSource),",")
strPathtoTextFile = tmpArray(0)
strFile=tmpArray(1)
'if path component not defined then exit script
If strPathtoTextFile=" " Then
WScript.Echo "Can't determine path to " & strSource & "."
WScript.Quit
End If
objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strPathtoTextFile & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
objRecordset.Open "SELECT * FROM " & strFile, _
objConnection, adOpenStatic, adLockOptimistic, adCmdText
'Create XML document
SET objXML = CreateObject("Microsoft.XMLDOM")
set objRoot=objXML.createNode("element","Main","")
objXML.appendChild(objRoot)
set objAttrib=objXML.createAttribute("Created")
objXML.documentElement.setAttribute "Created",Now
set objAttrib=objXML.createAttribute("Source")
objXML.documentElement.setAttribute "Source",strSource
Set objFields=objRecordset.Fields
Do Until objRecordset.EOF
'Create an "Item" tag for each entry in the file
Set objNode=objXML.createNode("Element","Item","")
objRoot.appendChild(objNode)
For z=0 To objFields.Count-1
strHeading=objFields.Item(z).name
'WScript.Echo "Adding element for " & strHeading
Set objChildNode=objXML.createNode("Element",strHeading,"")
'if value in CSV is blank
If IsNull(objRecordset.Fields(strHeading)) Then
strText="." 'we'll use a . so that the tag closes
Else
strText=objRecordset.Fields(strHeading)
End If
'set the value of the child node
objChildNode.text=strText
objNode.appendChild objChildNode
Next
objRecordset.MoveNext
Loop
objConnection.Close
'commit XML changes to disk
objXML.save(strXMLfile)
'display a summary message
WScript.Echo "Converted " & strSource & " to " & strXMLFile
Else
'display error message and quit script
WScript.Echo "Failed to find " & strSource
WScript.quit
End If
WScript.Quit
'//
'parse filename from path function
'//
Function GetFilePath(strFile)
'returns an csv array of path component and file component
On Error Resume Next
strTmp=StrReverse(strFile)
strFileName=Left(strTmp,InStr(strTmp,"/")-1)
strFileName=StrReverse(strFileName)
strPath=Mid(strTmp,InStr(strTmp,"/"))
strPath=StrReverse(strPath)
GetFilePath=strPath & "," & strFileName
End Function
'//
'Present OpenFile dialog box and return filename
'with path
'//
Function OpenFilePath()
On Error Resume Next
Dim objDialog
Set objDialog=CreateObject("SAFRCFileDlg.FileOpen")
objDialog.OpenFileOpenDlg
srcFile=objDialog.FileName
OpenFilePath=srcFile
End Function
'//
'Present the SaveAs dialogbox and return
'filename with path
'//
Function SaveAs(strFile)
'requires Windows XP or later
Dim objDialog
Set objDialog=CreateObject("SAFRCFileDlg.FileSave")
objDialog.filename=strFile
objDialog.OpenFileSaveDlg
SaveAs=objDialog.FileName
End function