Сохранение данных из Excel с поддержкой макросов в SQL

Question

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

Private Sub Clear_Click()
    Sheets("Encode").Range("D3").ClearContents
    Sheets("Encode").Range("D6").ClearContents
    Sheets("Encode").Range("C11:C30").ClearContents
    Sheets("Encode").Range("G11:G30").ClearContents
End Sub



Sub Save_Click()
    Dim i As Long, lastrow As Long, n As Long
    Dim vResult()
    Dim myWs As Worksheet

    Set myWs = ThisWorkbook.Sheets("DATABASE")

    If ActiveSheet.Range("d2") = "" Or ActiveSheet.Range("D7") = "" Or ActiveSheet.Range("d3") = "" Or ActiveSheet.Range("d4") = "" Or ActiveSheet.Range("d5") = "" Or ActiveSheet.Range("d6") = "" Or ActiveSheet.Range("C11") = "" Or ActiveSheet.Range("G11") = "" Then
        MsgBox "Please complete all fields!"
        Exit Sub
    End If

    i = 11
    Do While Cells(i, 3) <> "" And i < 30
        n = n + 1
        ReDim Preserve vResult(1 To 12, 1 To n)
        vResult(1, n) = ActiveSheet.Range("d6") ' Date
        vResult(2, n) = ActiveSheet.Range("d4") ' Source
        vResult(3, n) = ActiveSheet.Range("d5") ' Destination
        vResult(4, n) = ActiveSheet.Range("d3") ' Reference
        vResult(5, n) = ActiveSheet.Cells(i, 3) ' Item Code
        vResult(6, n) = ActiveSheet.Cells(i, 4) ' Description
        vResult(7, n) = ActiveSheet.Cells(i, 5) ' U/M
        vResult(8, n) = ActiveSheet.Cells(i, 6) ' Price
        vResult(9, n) = ActiveSheet.Cells(i, 7) ' QTY
        vResult(10, n) = ActiveSheet.Cells(i, 8) ' Amount
        vResult(11, n) = ActiveSheet.Range("d7") ' Transaction
        vResult(12, n) = ActiveSheet.Range("d2") ' Consignor
       i = i + 1
    Loop

    Dim wb As Workbook
    Set wb = Workbooks("IM WH.xlsm")

    With wb.Sheets(Range("D5").Text)
        .Range("a" & Rows.Count).End(xlUp)(2).Resize(n, 12) = WorksheetFunction.Transpose(vResult)
    End With

    myWs.Range("a" & Rows.Count).End(xlUp)(2).Resize(n, 12) = 
    WorksheetFunction.Transpose(vResult)
    MsgBox "Saved Succesfully!"

    Call Clear_Click
    ThisWorkbook.Save
End Sub

Answer 1

С какой базой данных вы работаете ??? Вот решение для Excel для доступа.

Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
    ' connect to the Access database
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\FolderName\DataBaseName.mdb;"
    ' open a recordset
    Set rs = New ADODB.Recordset
    rs.Open "TableName", cn, adOpenKeyset, adLockOptimistic, adCmdTable  
    ' all records in a table
    r = 3 ' the start row in the worksheet
    Do While Len(Range("A" & r).Formula) > 0 
    ' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            ' add values to each field in the record
            .Fields("FieldName1") = Range("A" & r).Value
            .Fields("FieldName2") = Range("B" & r).Value
            .Fields("FieldNameN") = Range("C" & r).Value
            ' add more fields if necessary...
            .Update ' stores the new record
        End With
        r = r + 1 ' next row
    Loop
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Sub

Вот решение для Excel для SQL Server.

Sub InsertInto()

Dim cnn As adodb.Connection
Dim cmd As adodb.Command
Dim strSQL As String

'Create a new Connection object
Set cnn = New adodb.Connection

'Set the connection string
cnn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=DB_Name;Data Source=Server_Name"



'Create a new Command object
Set cmd = New adodb.Command

'Open the Connection to the database
cnn.Open

'Associate the command with the connection
cmd.ActiveConnection = cnn

'Tell the Command we are giving it a bit of SQL to run, not a stored procedure
cmd.CommandType = adCmdText

'Create the SQL
strSQL = "UPDATE TBL SET JOIN_DT = '2013-01-22' WHERE EMPID = 2"

'Pass the SQL to the Command object
cmd.CommandText = strSQL


'Execute the bit of SQL to update the database
cmd.Execute

'Close the connection again
cnn.Close

'Remove the objects
Set cmd = Nothing
Set cnn = Nothing

End Sub