我经常被要求将excel电子表格中发送给我的数据与sql server中的数据进行比较。我知道您可以将SQL Server连接到电子表格，但它看起来总是很笨拙
这是一篇展示我解决方案的文章，但我很想听听其他人的想法。
最佳答案
为了获得最佳结果，请将下面的代码粘贴到personal.xls文件中的模块中。您需要添加对Microsoft Forms 2.0对象库的引用。
运行此例程时，它将获取当前突出显示的区域并创建XML字符串。它还创建tsql来将该xml转换为名为tmp的临时表。它还将TSQL粘贴到剪贴板中。它做了很多假设，默认的临时表是all varchar（100）。
我把这个程序绑定到cntl-shift-x。
最终的结果是，如果我高亮显示一个区域（带标题），单击cntl-shift-x，然后进入一个查询窗口，我可以立即访问sql中的电子表格数据。
我没有节省我很多时间。
欢迎提出改进建议：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, "&", "&")
tmp = Application.WorksheetFunction.Substitute(tmp, "'", "'")
tmp = Application.WorksheetFunction.Substitute(tmp, "<", "<")
tmp = Application.WorksheetFunction.Substitute(tmp, ">", ">")
tmp = Application.WorksheetFunction.Substitute(tmp, """", """)
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
如前所述，这里有一个例子。请考虑以下电子表格数据：
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
此方法将生成以下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