Простое использование данных Excel в SQL Server

Для достижения наилучших результатов вставьте приведенный ниже код в модуль в вашем файле personal.xls. Вам нужно будет добавить ссылку на библиотеку объектов Microsoft Forms 2.0.

Когда вы запускаете эту процедуру, она берет выделенную в данный момент область и создает строку XML. Он также создает TSQL для преобразования этого XML во временную таблицу с именем #tmp. Он также вставляет TSQL в буфер обмена. Он делает много предположений, и вся временная таблица по умолчанию - 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, "&", "&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

Как было предложено, вот пример. Рассмотрим данные этой электронной таблицы:

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

Я обнаружил, что у меня появляется сыпь, когда мне приходится работать с электронными таблицами, содержащими данные в неопределенном формате, который может со временем меняться.

Пара замечаний по коду:

В то время как Application.WorksheetFunction.Substitute выполняет свою работу, VB / VBA имеет функцию Replace, которая немного более лаконична. Вероятно, здесь это не особенно важно с точки зрения производительности, но обычно следует стараться как можно меньше ссылаться на объект Application или Workbook/Worksheets в коде, поскольку затраты на обход от кода к приложению, как правило, добавляют вверх. По этой причине при итерации по Range обычно имеет смысл загрузить значения в Variant, как в

Dim values as Variant
values = Selection.Values

и перебираем массив, чтобы исключить этот круговой обход каждый раз, когда вы ссылаетесь на .Cells.

Мне немного надоел theXML = theXML & - становится трудно понять, что происходит. Вы можете подумать о написании небольшого класса StringBuilder, скажем, чтобы уменьшить

 theXML = theXML & "INTO #tmp"

к

 sb.Add "INTO #tmp"

Метод Add может справиться и со всем этим делом с & vbCrLf, что, честно говоря, было бы благом.

Тем не менее, мне интересно, какой бизнес-процесс требует регулярных проверок такого рода. Есть ли намерение гарантировать, что данные одинаковы в обоих местах? Дублирование / согласование часто является признаком того, что процесс требует некоторого рефакторинга. Если вы ищете различия, может быть лучший способ их записать? Как можно что-то изменить, чтобы данные можно было изменять только в базе данных? Просто интересуюсь...