Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Editing a txt file using Access VBA 1

Status
Not open for further replies.
534dna

534dna

Technical User
Jul 13, 2012
10
DE
Hi folks,

I have an XML file which I need to modify in MS access.

In the XML file I have some code like this:

Code: 
	<question id="01" difficulty="easy">
            <name>user1</name>
            <body>Question blah blah</body>
            <date>
              <date year="2008" month="5" day="17" hour="2" minute="31" second="11"/>
            </date>
          </question>

I need my vba code to find the <question> start tag and take the id and difficulty attributes and convert them to tags so the above will be:

Code: 
	<question>
		<id>01</id>
		<difficulty>easy</difficulty>
		<body>Question blah blah</body>
		<date>
			<date year="2008" month="5" day="17" hour="2" minute="31" second="11"/>
		</date>
	</question>

I have built a small form for finding and replacing strings in text files with 3 text boxes where i can enter the file name, the text I want to replace and the replacement text. I want to modify the code i have for it (which is spliced-together code from some tutorials I found online).

The code I have is as follows:

Code: 
'Set a Reference to the Microsoft Scripting Runtime Library
Dim objFSO As FileSystemObject
Dim ts As TextStream
Dim strText As String
Dim strSearchText As String
Dim strFileName As String
Dim lngPos As Long
Dim lngStringCount As Long
Dim strNewText As String
Dim strReplaceText As String
Do
strSearchText = Me.searchtext
strReplaceText = Me.replacetext
strFileName = Me.fileselector
'Create instance of FileSystemObject.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ts = objFSO.OpenTextFile(strFileName, ForReading)
  
'Read entire contents of file, save to strText variable
strText = ts.ReadAll
  
lngPos = 1
  

  lngPos = InStr(lngPos, strText, strSearchText)
    If lngPos > 0 Then
      lngStringCount = lngStringCount + 1
      lngPos = lngPos + Len(strSearchText)
    End If
    
    ts.Close
    strNewText = Replace(strText, strSearchText, strReplaceText, 1, 1, vbTextCompare)
    FirstPos = 0
    For i = 1 To 3
    FirstPos = InStr(FirstPos + 1, strNewText, strSearchText, 1)
    Next
    Set ts = objFSO.OpenTextFile(strFileName, ForWriting)
    ts.WriteLine strNewText
    ts.Close
    
Loop Until lngPos = 0
  
MsgBox "The String [" & strSearchText & "] has been replaced by [" & strReplaceText & "] " & lngStringCount & " time(s) in the " & _
       "File " & strFileName, vbInformation, "XML Processor"

I have tried but I cant get anywhere with it. My knowledge of this is lacking methinks.

Any help much appreciated.
 
Sort by date Sort by votes
Sorry the second bit of code should be:

Code: 
<question>
		<id>01</id>
		<difficulty>easy</difficulty>
		<name>user1</name>
            	<body>Question blah blah</body>
		<date>
			<date year="2008" month="5" day="17" hour="2" minute="31" second="11"/>
		</date>
</question>
 
Upvote 0 Downvote
Thanks for that link. I've tried to get the attributes out and I'm not sure what i'm doing wrong. Can't find much information online on this. This is the code I have so far (consists mostly of the code from the link you supplied). The first sub is run by a button.

Code: 
Private Sub XML1_Click()

Set objParser = CreateObject("Microsoft.XMLDOM")
Dim xDoc As MSXML.DOMDocument
Set xDoc = New MSXML.DOMDocument

xDoc.async = False
If xDoc.Load(Me.fileselector.Value) Then
   ' The document loaded successfully.
   ' Now do something intersting.
   DisplayNode xDoc.ChildNodes, 0
Else
   ' The document failed to load.
   
   Dim strErrText As String
   Dim xPE As MSXML.IXMLDOMParseError
   ' Obtain the ParseError object
   Set xPE = xDoc.parseError
   With xPE
      strErrText = "Your XML Document failed to load" & _
        "due the following error." & vbCrLf & _
        "Error #: " & .ErrorCode & ": " & xPE.reason & _
        "Line #: " & .Line & vbCrLf & _
        "Line Position: " & .linepos & vbCrLf & _
        "Position In File: " & .filepos & vbCrLf & _
        "Source Text: " & .srcText & vbCrLf & _
        "Document URL: " & .URL
    End With

    MsgBox strErrText, vbExclamation
End If

Set xDoc = Nothing

End Sub

Public Sub DisplayNode(ByRef Nodes As MSXML.IXMLDOMNodeList, _
   ByVal Indent As Integer)

   Dim xNode As MSXML.IXMLDOMNode
   Dim xId As IXMLDOMAttribute
   Dim xStatus As IXMLDOMAttribute
   
   xId = xNode.Attributes.getNamedItem("id")
   xStatus = xNode.Attributes.getNamedItem("difficulty")
   
   Indent = Indent + 2

   For Each xNode In Nodes
      If xNode.NodeType = NODE_TEXT Then
         Debug.Print Space$(Indent) & xNode.ParentNode.nodeName & _
            ":" & xNode.NodeValue & ":" & xId & xStatus
      End If

      If xNode.HasChildNodes Then
         DisplayNode xNode.ChildNodes, Indent
      End If
   Next xNode
End Sub

I get an error at:

xId = xNode.Attributes.getNamedItem("id")

I'm doing something wrong here!

Thanks again for all the help.
 
Upvote 0 Downvote
Thanks for that link. I've tried to get the attributes out and I'm not sure what i'm doing wrong. Can't find much information online on this. This is the code I have so far (consists mostly of the code from the link you supplied). The first sub is run by a button.

Code: 
Private Sub XML1_Click()

Set objParser = CreateObject("Microsoft.XMLDOM")
Dim xDoc As MSXML.DOMDocument
Set xDoc = New MSXML.DOMDocument

xDoc.async = False
If xDoc.Load(Me.fileselector.Value) Then
   ' The document loaded successfully.
   ' Now do something intersting.
   DisplayNode xDoc.ChildNodes, 0
Else
   ' The document failed to load.
   
   Dim strErrText As String
   Dim xPE As MSXML.IXMLDOMParseError
   ' Obtain the ParseError object
   Set xPE = xDoc.parseError
   With xPE
      strErrText = "Your XML Document failed to load" & _
        "due the following error." & vbCrLf & _
        "Error #: " & .ErrorCode & ": " & xPE.reason & _
        "Line #: " & .Line & vbCrLf & _
        "Line Position: " & .linepos & vbCrLf & _
        "Position In File: " & .filepos & vbCrLf & _
        "Source Text: " & .srcText & vbCrLf & _
        "Document URL: " & .URL
    End With

    MsgBox strErrText, vbExclamation
End If

Set xDoc = Nothing

End Sub

Public Sub DisplayNode(ByRef Nodes As MSXML.IXMLDOMNodeList, _
   ByVal Indent As Integer)

   Dim xNode As MSXML.IXMLDOMNode
   Dim xId As IXMLDOMAttribute
   Dim xStatus As IXMLDOMAttribute
   
   xId = xNode.Attributes.getNamedItem("id")
   xStatus = xNode.Attributes.getNamedItem("difficulty")
   
   Indent = Indent + 2

   For Each xNode In Nodes
      If xNode.NodeType = NODE_TEXT Then
         Debug.Print Space$(Indent) & xNode.ParentNode.nodeName & _
            ":" & xNode.NodeValue & ":" & xId & xStatus
      End If

      If xNode.HasChildNodes Then
         DisplayNode xNode.ChildNodes, Indent
      End If
   Next xNode
End Sub

I get an error at:

xId = xNode.Attributes.getNamedItem("id")

I'm doing something wrong here!

Thanks again for all the help.
 
Upvote 0 Downvote
Thanks for that link.

I can't seem to get past the code provided in that link. I need to get the "id" and "difficulty" attributes. The code in the tutorial works but does not show me the attributes. I have looked online and nothing I have found will work.
 
Upvote 0 Downvote
A couple of extra links you might find useful are to give you the basics on using the XML DOM and for the details of using the MS implementation.

Using those links you should be able to follow this function I've created.
Code: 
Function SortAttributes(sFile As String)
    Dim xmlDoc As Object
    Set xmlDoc = CreateObject("MSXML.DOMDocument")
    xmlDoc.async = False
    If xmlDoc.Load(sFile) Then
        Dim nodeList As Object, node As Object, attr As Object

        Set nodeList = xmlDoc.getElementsByTagName("question")    'Gets all of the question nodes
        For Each node In nodeList    'loop through each of the "question nodes and strip out it's attributes
            For Each attr In node.Attributes
                If attr.Name = "id" Or attr.Name = "difficulty" Then
                    Dim newNode As Object, newTextNode As Object
                    'create a new node
                    Set newNode = xmlDoc.createElement(attr.Name)

                    'create the text element
                    Set newTextNode = xmlDoc.createTextNode(attr.Value)

                    'add the value to the new element
                    newNode.appendChild newTextNode

                    'append the new element to our question node
                    node.appendChild newNode

                    'remove this attribute
                    node.removeAttribute attr.Name

                End If

            Next attr
        Next node

        SortAttributes = xmlDoc.XML
    Else
        Debug.Print "Error loading file"
    End If
End Function

hth


Ben

----------------------------------------------
Ben O'Hara
David W. Fenton said:
We could be confused in exactly the same way, but confusion might be like Nulls, and not comparable.
Click to expand...
 
Upvote 0 Downvote
Thanks for the reply.

That code runs but doesn't seem to do anything with my xml file. It runs without error but the xml file remains the same.
 
Upvote 0 Downvote
The code I've posted doesn't save the document, it just outputs the xml as a string (that was all I needed for my testing).
To save the file you need to call the save method of the xml document.

hth

Ben



----------------------------------------------
Ben O'Hara
David W. Fenton said:
We could be confused in exactly the same way, but confusion might be like Nulls, and not comparable.
Click to expand...
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

M
  • Question
display a calendar with appointments in body of html email with access vba
Replies
1
Views
374
SoftwareRT
SoftwareRT
Moss100
  • Locked
  • Question
Filter vba problem
Replies
1
Views
276
Andrzejek
Andrzejek
Omarahmed22
  • Locked
  • Question
VBA Formating
Replies
1
Views
230
Andrzejek
Andrzejek
aldi07
  • Locked
  • Question
update a front-end database with a new release using vba
Replies
5
Views
177
aldi07
aldi07
Moss100
  • Question
Access send email attachments - problem when null or empty
Replies
7
Views
371
Andrzejek
Andrzejek

Part and Inventory Search

Sponsor

Back
Top