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

Comment Section

Comments are closed.