Need VBA code to save file as XML with specific name

CRGman
CRGman used Ask the Experts™
on
I am working on a database that creates an XML file for every record that is updated in a table.   The file name of the record must be named the value of one of the field names.  

This record is created to contain descriptive data about an image file that is created outside the database but the name of the image file is populated into the record that is being updated and this name is what the file name for the record being updated in the Access database needs to be named.  

Can anyone help me out with the code to:
1.   Save a file as XLM for a specific record
2.   Name a file using the value of a field name in a specific record

Thanks!
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2010

Commented:
It would be helpful for you to post a sample database, and some examples of the output you are expecting given that sample input.
Commented:
You can pull up the updated record in a recordset then write each record to a text file and give it your field name.
You will need the Microsoft Scripting  reference.
This will create one xml file per record:

Dim fso As Scripting.FileSystemObject
Dim ts As Object
Dim rs as DAO.Recordset
Dim Z as Integer
Dim strPath as String

Set rs=Currentdb.Openrecordset("SELECT ID, Data FROM Table1 WHERE (((ID)=" & Form_Form1.ID & "));",dbOpenSnapshot)
With rs
     If .BOF and .EOF then     'no records, close recordset
          .close
     Else     'records exist
          .MoveLast
          .MoveFirst
          For Z = 1 to .RecordCount
               strPath="C:\Folder\" & ![Data] & ".xml"
               Set fso = New Scripting.FileSystemObject
               Set ts = fso.CreateTextFile(strPath, True)
               ts.WriteLine "<dataroot>"       'Begin data
               ts.WriteLine "<ExportData>"   'Begin Record
               ts.WriteLine "<ID>" & ![ID] & "</ID>"        'Field
               ts.WriteLine "<Data>" & ![Data] & "</Data>"   'Field
               ts.WriteLine "</ExportData>"      'End of Record
               ts.WriteLine "</dataroot>"          'End of Data
               ts.Close
               Set ts=Nothing
               Set fso=Nothing
          Next Z
          .Close
     End If
End With
rs.close
Set rs=Nothing

Open in new window

Author

Commented:
I am a novice at VBA but I am running into a problem.   I am getting a compile error on the DIM fso As Scripting.FileSystemObject

I get "User-defined type not defined"

Can you help?

I did download the Microsoft Scripting Reference file
Success in ‘20 With a Profitable Pricing Strategy

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Top Expert 2010
Commented:
One of two things:

1) In the VB Editor, go to Tools/References, and check the box for Microsoft Scripting Runtime; or

2) Change:

Dim fso As Scripting.FileSystemObject

Open in new window


to

Dim fso As Object 'Scripting.FileSystemObject

Open in new window


and change:

Set fso = New Scripting.FileSystemObject

Open in new window


to:

Set fso = CreateObject("Scripting.FileSystemObject")

Open in new window

Commented:
matthewspatrick is correct.  The code I provided needs the 'Microsoft Scripting RunTime' reference added.  If you use the changes he posted you do not need the reference.

Author

Commented:
Ok,  that got me a little further, but now I am getting a syntax error on the:

Set rs = CurrentDb.OpenRecordset("SELECT * FROM [tblAPInvoiceImageIndexTable] WHERE ([tblAPInvoiceImageIndexTable]![descriptFileCreated] = 0)"));", dbOpenSnapshot

If I comment out the dbOpenSnapShot the error goes away, but the code does not produce any output.

What am I doing wrong?

Code as it stands right now:

Dim fso As Object 'Scripting.FileSystemObject  Must down load Microsoft Scripting Reference in order to make this work
Dim ts As Object
Dim rs As DAO.Recordset
Dim Z As Integer
Dim strPath As String
Dim counter As Integer

Set rs = CurrentDb.OpenRecordset("SELECT * FROM [tblAPInvoiceImageIndexTable] WHERE ([tblAPInvoiceImageIndexTable]![descriptFileCreated] = 0)"));", dbOpenSnapshot
With rs
     If .BOF And .EOF Then     'no records, close recordset
          .Close
     Else     'records exist
          .MoveLast
          .MoveFirst
           
        For Z = 1 To .RecordCount   'counter rs.RecordCount 'finds number of records in recordset
               
 
            strPath = "C:\Folder\" & ![ImageNumber] & ".xml"
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set ts = fso.createTextFile("strPath", True)   'added "" to strPath
           
            ts.WriteLine "<dataroot>"           'Begin data
            ts.WriteLine "<ExportData>"         'Begin Record
           
            ts.WriteLine "<VendorNumb>" & ![VendorNumb] & "</VendorNumb>"                         'Field
            ts.WriteLine "<InvoiceNumber>" & ![InvoiceNumber] & "</InvoiceNumber>"                'Field
            ts.WriteLine "<ImageNumber>" & ![ImageNumber] & "</ImageNumber>"                      'Field
            ts.WriteLine "<Invoice Date>" & ![Invoice Date] & "</Invoice Date>"                   'Field
            ts.WriteLine "<CommentHeader>" & ![CommentHeader] & "</CommentHeader>"                'Field
            ts.WriteLine "<TotalInvoiceAmt>" & ![TotalInvoiceAmt] & "</TotalInvoiceAmt>"          'Field
            ts.WriteLine "<Vendor-InvoiceNumb>" & ![Vendor-InvoiceNumb] & "</Vendor-InvoiceNumb>" 'Field
         
            ts.WriteLine "</ExportData>"        'End of Record
            ts.WriteLine "</dataroot>"          'End of Data
            ts.Close
            Set ts = Nothing
            Set fso = Nothing
           
            Next Z
            .Close
     End If
End With
rs.Close
Set rs = Nothing
                                           

End Sub
Commented:
A couple things:
1.  Remove '.Close' after the 'If .BOF And .EOF' line and the one after the 'Next Z' line because your closing it after the entire IF statement.

2.  Looks like your missing some parenthesis.  Should be:
Set rs = CurrentDb.OpenRecordset("SELECT * FROM [tblAPInvoiceImageIndexTable] WHERE ((([tblAPInvoiceImageIndexTable]![descriptFileCreated]) = 0));", dbOpenSnapshot)

Author

Commented:
I am getting close.   The is compiling without error but it is still not writing a file.

Here is what I have now:

Dim fso As Object 'Scripting.FileSystemObject  Must down load Microsoft Scripting Reference in order to make this work
Dim ts As Object
Dim rs As DAO.Recordset
Dim Z As Integer
Dim strPath As String
Dim counter As Integer
Set rs = CurrentDb.OpenRecordset("SELECT * FROM [tblAPInvoiceImageIndexTable] WHERE ((([tblAPInvoiceImageIndexTable]![descriptFileCreated]) = 0));", dbOpenSnapshot)

With rs
        If .BOF And .EOF Then    'no records, close recordset
            ' rs.Close
        Else
            .MoveLast
            .MoveFirst
                   
            For Z = 1 To .RecordCount   'counter rs.RecordCount 'finds number of records in recordset
               
                strPath = "C:\Data\PurchasingDatabaseUpgrade\" & ![ImageNumber] & ".xml"
                Set fso = CreateObject("Scripting.FileSystemObject")
                Set ts = fso.createTextFile("strPath", True)   'added "" to strPath
           
                ts.WriteLine "<dataroot>"           'Begin data
                ts.WriteLine "<ExportData>"         'Begin Record
           
                ts.WriteLine "<VendorNumb>" & ![VendorNumb] & "</VendorNumb>"                         'Field
                ts.WriteLine "<InvoiceNumber>" & ![InvoiceNumber] & "</InvoiceNumber>"                'Field
                ts.WriteLine "<ImageNumber>" & ![ImageNumber] & "</ImageNumber>"                      'Field
                ts.WriteLine "<Invoice Date>" & ![Invoice Date] & "</Invoice Date>"                   'Field
                ts.WriteLine "<CommentHeader>" & ![CommentHeader] & "</CommentHeader>"                'Field
                ts.WriteLine "<TotalInvoiceAmt>" & ![TotalInvoiceAmt] & "</TotalInvoiceAmt>"          'Field
                ts.WriteLine "<Vendor-InvoiceNumb>" & ![Vendor-InvoiceNumb] & "</Vendor-InvoiceNumb>" 'Field
         
                ts.WriteLine "</ExportData>"        'End of Record
                ts.WriteLine "</dataroot>"          'End of Data
                ts.Close
                Set ts = Nothing
                Set fso = Nothing
           
            Next Z
           
        End If
       
End With

rs.Close
Set rs = Nothing



What would cause this code to not generate an output?
Top Expert 2010
Commented:
Put a break point on this line:

     ' rs.Close

Open in new window


Does execution halt there?  If so, then your query returned no records.

If that is not it, replace:

        For Z = 1 To .RecordCount   'counter rs.RecordCount 'finds number of records in recordset

Open in new window


with:

        Do Until .EOF

Open in new window


and replace:

            Next Z

Open in new window


with:


                .MoveNext
            Loop

Open in new window

Author

Commented:
Ok  I tried checking some variable values and I have determined that the counter values are being populated and that there is 20 records in the recordset.   I have also determined that the path string is working.  It appears the variable names being written to the XML file are not being populated.  

There must either be an error in the names of the variables.   Do I need to create DIM statements for each of these field values/variables?
Top Expert 2010
Commented:
You should ALWAYS declare your variables.  Indeed, you should change your VBA Editor options to require variable declaration (that puts Option Explicit in as a module-level declaration).

I just noticed that your code has no .MoveNext command, so on each pass through the For...Next loop it is just re-using the first record in the recordset :)

Author

Commented:
Ok,  thanks...yea I caught the missing .movenext statement.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial