Question

I am regularly required to compare data sent to me in Excel spreadsheets with data that lives in SQL Server. I know that you can connect SQL Server to spreadsheets but it always seemed clunky

This is really a post to show off my solution but I would love to hear other peoples ideas.

Answer 1

For best results, paste the below code into a module in your personal.xls file. You will need to add a reference to the Microsoft Forms 2.0 Object Library.

When you run this routine, it takes the currently highlighted region and creates an XML string. It also creates the TSQL to convert that XML into a temporary table called #tmp. It also pastes the TSQL into your clipboard. It makes a lot of assumptions and the default temporary table is all VARCHAR(100).

I bound this routine to Cntl-Shift-X.

The end result is if i highlight a reagion (with header), click Cntl-Shift-X, and past into a query window, I have immediate access to the spreadsheet data in SQL.

I’t has save me tons of time.

Recommendations for improvements are welcome :o)

Sub CreateOpenXML()      Dim cols, rows As Long     cols = Selection.Columns.Count     rows = Selection.rows.Count     Dim Header() As String     ReDim Preserve Header(cols)     For i = 1 To cols  '''Each Column In Selection.Rows(0).Columns         Header(i) = CleanHeader(Selection.Cells(1, i).Value)         'Header(i) = Application.WorksheetFunction.Substitute(CleanString(Selection.Cells(1, i).Value), ' ', '_')         'Header(i) = Application.WorksheetFunction.Substitute(Header(i), '(', '_')         'Header(i) = Application.WorksheetFunction.Substitute(Header(i), ')', '_')         'i = i + 1     Next     Dim theXML As String, tmpXML As String, counter As Integer      theXML = 'DECLARE @DocHandle int' & vbCrLf     theXML = theXML & 'DECLARE @XmlDocument varchar(8000)' & vbCrLf     theXML = theXML & 'EXEC sp_xml_preparedocument @DocHandle OUTPUT, N'<theRange>' & vbCrLf     tmpXML = ''     counter = 0     For i = 2 To rows         tmpXML = tmpXML & vbTab & '<theRow>'         For j = 1 To cols             If Selection.Cells(i, j).Text <> 'NULL' And Selection.Cells(i, j).Text <> '' Then                 tmpXML = tmpXML & '<' & Header(j) & '>' & CleanString(Selection.Cells(i, j).Text) & '</' & Header(j) & '>'                 'tmpXML = tmpXML & CleanString(Selection.Cells(i, j).Text)                 'tmpXML = tmpXML & '</' & Header(j) & '>'             End If         Next j         tmpXML = tmpXML & '</theRow>' & vbCrLf         counter = counter + 1         If counter = 200 Then             theXML = theXML & tmpXML             tmpXML = ''             counter = 0         End If     Next i     theXML = theXML & tmpXML     theXML = theXML & '</theRange>'' & vbCrLf & vbCrLf     '''theXML = theXML & 'EXEC sp_xml_preparedocument @DocHandle OUTPUT, @XmlDocument' & vbCrLf     theXML = theXML & 'SELECT '     For i = 1 To cols         theXML = theXML & '[' & Header(i) & ']'         If i <> cols Then theXML = theXML & ', '     Next     theXML = theXML & vbCrLf     theXML = theXML & 'INTO #tmp'     theXML = theXML & vbCrLf     theXML = theXML & 'FROM OPENXML (@DocHandle, '/theRange/theRow',2) WITH (' & vbCrLf     For i = 1 To cols         theXML = theXML & vbTab & '[' & Header(i) & '] varchar(100)'         If i <> cols Then theXML = theXML & ','         theXML = theXML & vbCrLf     Next     theXML = theXML & ')' & vbCrLf     theXML = theXML & 'EXEC sp_xml_removedocument @DocHandle' & vbCrLf     theXML = theXML & vbCrLf     theXML = theXML & 'Select * from #tmp' & vbCrLf     theXML = theXML & vbCrLf     theXML = theXML & '--DROP TABLE  #tmp'     theXML = theXML & vbCrLf     MsgBox 'The XML has been copied to the clipboard'     Dim dob As New DataObject     dob.SetText (theXML)     dob.PutInClipboard  End Sub  Function CleanString(orig As String)     Dim tmp As String     tmp = orig     '''MsgBox InStr(orig, '&')     If InStr(orig, '&') > 0 Or InStr(orig, ''') > 0 Or InStr(orig, '<') > 0 Or InStr(orig, '>') > 0 Or InStr(orig, '''') > 0 Then         tmp = Application.WorksheetFunction.Substitute(tmp, '&', '&amp;')         tmp = Application.WorksheetFunction.Substitute(tmp, ''', '&apos;')         tmp = Application.WorksheetFunction.Substitute(tmp, '<', '&lt;')         tmp = Application.WorksheetFunction.Substitute(tmp, '>', '&gt;')         tmp = Application.WorksheetFunction.Substitute(tmp, '''', '&quot;')     End If     CleanString = tmp  End Function  Function CleanHeader(orig As String)     Dim tmp As String     tmp = Trim(orig)     If InStr(orig, ' ') > 0 Or InStr(orig, '(') > 0 Or InStr(orig, ')') > 0 Or InStr(orig, '$') > 0 Or InStr(orig, '/') > 0 Or InStr(orig, '?') > 0 Or InStr(orig, '&') > 0 Or InStr(orig, ''') > 0 Or InStr(orig, '<') > 0 Or InStr(orig, '>') > 0 Or InStr(orig, '''') > 0 Then         tmp = Application.WorksheetFunction.Substitute(tmp, '&', 'And')         tmp = Application.WorksheetFunction.Substitute(tmp, ''', '_')         tmp = Application.WorksheetFunction.Substitute(tmp, '<', '')         tmp = Application.WorksheetFunction.Substitute(tmp, '>', '')         tmp = Application.WorksheetFunction.Substitute(tmp, '''', '')         tmp = Application.WorksheetFunction.Substitute(tmp, ' ', '_')         tmp = Application.WorksheetFunction.Substitute(tmp, '(', '_')         tmp = Application.WorksheetFunction.Substitute(tmp, ')', '_')         tmp = Application.WorksheetFunction.Substitute(tmp, '$', '')         tmp = Application.WorksheetFunction.Substitute(tmp, '/', '')         tmp = Application.WorksheetFunction.Substitute(tmp, '?', '')     End If     CleanHeader = tmp  End Function  Sub MakeText()      ActiveCell.CurrentRegion.Select     Dim rng As Range     Set rng = Selection      Dim str As String     For i = 1 To rng.rows.Count         For j = 1 To rng.Columns.Count             str = Application.WorksheetFunction.Text(rng.Cells(i, j).Value, '#')             rng.Cells(i, j).NumberFormat = '@'             rng.Cells(i, j).Value = str         Next j     Next i  End Sub 

As suggested, here’s an example. Consider this spreadsheet data:

Name              DOB       Score   Comment John Smith        7/1/1990  93      Great effort Sue Jones         1/1/1989  95      Super achievement Robin Sixpack     12/1/1985 100     OK 

This method will generate the following TSQL:

DECLARE @DocHandle int DECLARE @XmlDocument varchar(8000) EXEC sp_xml_preparedocument @DocHandle OUTPUT, N'<theRange>     <theRow><Name>John Smith</Name><DOB>7/1/1990</DOB><Score>93</Score><Comment>Great effort</Comment></theRow>     <theRow><Name>Sue Jones</Name><DOB>1/1/1989</DOB><Score>95</Score><Comment>Super achievement</Comment></theRow>     <theRow><Name>Robin Sixpack</Name><DOB>12/1/1985</DOB><Score>100</Score><Comment>OK</Comment></theRow> </theRange>'  SELECT [Name], [DOB], [Score], [Comment] INTO #tmp FROM OPENXML (@DocHandle, '/theRange/theRow',2) WITH (     [Name] varchar(100),     [DOB] varchar(100),     [Score] varchar(100),     [Comment] varchar(100) ) EXEC sp_xml_removedocument @DocHandle  Select * from #tmp  --DROP TABLE  #tmp