This weekend I was working on a spreadsheet and I needed to save the data as a recordset. Unfortunately there didn't seem to be a way to do it easily without VBA macros. So I wrote this macro to save the current worksheet as an ADODB.Recordset XML file. Remember to add a reference to Microsoft.ActiveX Data Object 2.8 Library in the Excel Visual Basic Editor.
Public Sub CreateAdoRecordsetXml()
Dim rst As New ADODB.Recordset
Dim sheet As Worksheet
Dim col As Long, colcount As Long
Dim row As Long, rowcount As Long
Dim Filename As String
Filename = ActiveWorkbook.Path + "\" + ActiveSheet.Name + ".xml"
Set sheet = ActiveSheet
colcount = sheet.UsedRange.Columns.count
rowcount = sheet.UsedRange.Rows.count
col = 1
row = 1
Do While col <= colcount
Call rst.Fields.Append(sheet.Cells(row, col).Text, adVarChar, 255, adFldMayBeNull)
col = col + 1
Loop
rst.Open
row = 2
Do While row <= rowcount
col = 1
Call rst.AddNew
With rst.Fields
Do While col <= colcount
If sheet.Cells(row, col).Text <> "" Then
.Item(col - 1).Value = sheet.Cells(row, col).Text
End If col = col + 1
Loop
End With
Call rst.Update row = row + 1
Loop
Call rst.Save(Filename, adPersistXML)
End Sub
Comments are closed.