Vbs code for saving information to an XML file

Source: Internet
Author: User

This script demonstrates how to save information to a xml file with the use of MSXML. The example xml file is used for the photo album on the site. Copy codeThe Code is as follows: '*************************************** **************************
'** Script: CreateXML. vbs
'** Version: 1.0
'** Created: 01/12/2009 PM
'** Author: Adriaan Westra
'** E-mail:
'** Purpose/Comments:
'** Create xml file for photo album
'**
'**
'** Changelog:
'**: Initial version
'**
'*************************************** **************************

On Error Resume next
Dim Version: Version = "1.0" 'script version
Dim Author: Author = "A. Westra"
Dim objXML 'xml Document object
Dim root 'root element of the xml document
Dim newnode'xml Node object
Dim cNode 'xml (child) Node object
Dim cNodeText 'xml Text Node object

'*************************************** **************************
'** Make sure the script is started with cscript
If InStr (wscript. FullName, "wscript.exe")> 0 Then
MsgBox "Please run this script with cscript.exe." & Chr (13 )&_
"For example: cscript" & WScript. ScriptName &"/? ",_
VbExclamation, WScript. ScriptName
WScript. Quit (1)
End If

'*************************************** **************************
'** Get commandline parameters
Set Args = Wscript. Arguments

If Args. Count = 0 Then
StrImageDir = InputBox ("Please give the directory name "&_
"To process:", wscript. scriptname, strPath)
Else
If InStr (Args (0 ),"/? ")> 0 Or InStr (UCase (Args (0),"/H ")> 0 _
Or InStr (UCase (Args (0), "/HELP")> 0 Then
DisplayHelp
Wscript. quit (0)
Else
StrImageDir = Args (0)
End if
End if

Set objXML = CreateObject ("Msxml2.DOMDocument. 6.0 ")
ObjXML. setProperty "SelectionLanguage", "XPath"

'*************************************** **************************
'** Determine if the file exists
StrXMLFile = strImageDir & "\ album. xml"
Set objFSO = CreateObject ("Scripting. FileSystemObject ")
If objFSO. FileExists (strXMLFile) Then
'*************************************** **************************
'** Read the XML File
ObjXML. load (strXMLFile)
Else
'*************************************** **************************
'** Create the XML File
ObjXML. loadXML ("")
End If
'*************************************** **************************
'** Process directory
Set objImgDir = objFSO. GetFolder (strImageDir)
For each objFile in objImgDir. Files
If IsJPG (objFile. Name) Then
ArrTemp = split (objFile. Name ,".")
StrNode = arrTemp (0)

'*************************************** **************************
'** Determine if the node exists
If Not XmlNodeExists (strChildNode, objXML) Then
'*************************************** **************************
'** Get the root element of the xml document
Set root = objXML.doc umentElement
'*************************************** **************************
'** Create the new node
Set newNode = objXML. createNode (1, strNode ,"")
Root. appendChild newNode
Set cNode = objXML. createNode (1, "alt ","")
Set cNodeText = objXML. createNode (3 ,"","")
CNodeText. Text = strNode
CNode. appendChild cNodeText
NewNode. appendChild cNode
Set cNode = objXML. createNode (1, "Title ","")
Set cNodeText = objXML. createNode (3 ,"","")
CNodeText. Text = strNode
CNode. appendChild cNodeText
NewNode. appendChild cNode
End If
End If
Next
'*************************************** **************************
'** Save the xml file
ObjXML. save (strXMLFile)

'*************************************** **************************
'** End the script
Wscript. quit

'*************************************** **************************
'** Function: XmlNodeExists
'** Version: 1.0
'** Created: 1/12/2009 PM
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose/Comments:
'** Determines if a node exists in XML
'**
'** Arguments:
'** StrNode: Name of the XML node
'** OXML: XMl DOM Object

'**
'** Changelog:
'** 1/12/2009 12:16 PM: Initial version
'**
'*************************************** **************************
Function XmlNodeExists (strNode, oXML)
On Error Resume next
Set oNode = oXML. selectSingleNode (strNode)
StrNodetype = oNode. nodetype
If err. number = 0 Then
XmlNodeExists = True
Else
XmlNodeExists = False
End if
End Function
'*************************************** **************************
'** Sub: DisplayHelp
'** Version: 1.0
'** Created: 24-03-2003 8: 22
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose/Comments:
'** Display help for script
'**
'** Arguments:
'**
'** Wijzigingslog:
'** 24-03-2003 8:22: Initi bought e versie
'**
'*************************************** **************************
Sub DisplayHelp ()
StrComment = string (2 ,"*")
StrCmntLine = String (79 ,"*")
Wscript. echo strCmntline
Wscript. echo strComment
Wscript. echo strComment & "Online help "&_
Wscript. scriptname & "version:" & Version
Wscript. echo strComment
Wscript. echo strComment & "Usage: cscript "&_
Wscript. scriptname & "directoryname"
Wscript. echo strComment
Wscript. echo strComment & "Purpose: Create XML file "&_
"For all images in given directory ."
Wscript. echo strComment
Wscript. echo strComment & "Author:" & Author
Wscript. echo strComment & "E-mail:" & Email
Wscript. echo strComment
Wscript. echo strCmntline
End Sub
'*************************************** **************************
'** Function: IsJPG
'** Version: 1.0
'** Created: 12/29/2008 11: 01 PM
'** Author: Adriaan Westra
'** E-mail:
'**
'** Purpose/Comments:
'** Determine if file is jpg image
'**
'** Arguments:
'** StrFilename: name of the file to check
'**
'** Wijzigingslog:
'** 12/29/2008 :02 PM: Initi {e versie
'**
'*************************************** **************************
Function IsJPG (strFilename)
Set objRegExp = New RegExp
ObjRegExp. Pattern = "\ invalid jpg"
ObjRegExp. IgnoreCase = True
IsJPG = objRegExp. Test (strFileName)
End Function

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.