我有一个启用了宏的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
答案 0 :(得分:0)
您正在使用哪种数据库???这是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