vba, excel, wps, sql server save

vba, excel, wps, sql server save

 

Option-Private Module1 
'Public Const ID of As String = "WIN-OM179101SM0 \ SQLEXPRESS"' database server name 
Public Const ID of As String = "WIN-OM179101SM0" 
Public Const the DataBase of As String = "Demo" 'Database Name 
Public Const UserName As String = "sa" 'database user name 
Public Const passWord As String = "11111111 "' database connection password 


Sub ExcelToServer () 
    Dim CN New ADODB.Connection of As,% I, J%, strTable $, n- 
    Dim RS of As New ADODB.Recordset 
    cnStr of As String Dim, the SQL of As String, wsName $ 
    wsName = ActiveSheet.Name 
    'Cells (. 1,. 5) .Value = wsName 
    the On Error the GoTo errHandle  
    cnStr = "Provider = SQLOLEDB; Server =" & ID & ";Database=" & DataBase & ";Uid=" & UserName & ";Pwd=" & PassWord & ";"
    cn.ConnectionTimeout = 10 
    the cn.Open cnStr
    SQL = "if exists(select * from sysobjects where name='" & wsName & "') drop table " & wsName
    i = Cells(1, 16384).End(xlToLeft).Column
    strTable = " create table " & wsName & "("
    For j = 1 To i
        If Cells(1, j).Value = "" Then
            MsgBox "检测到标题行存在空值，导入失败！", vbInformation, "提醒"
            Exit Sub
        Else
            If j = 1 Then
                strTable = strTable & Cells(1, j).Value & " varchar(100) null"
            Else
                strTable = strTable & "," & Cells(1, j).Value & " varchar(100) null"
            End If
        End If
    Next
    SQL = SQL & strTable & ")"
    End the If
    
    
     
    IF cn.State = cn.Close adStateOpen the Then 
    Exit Sub 
errHandle: 
    MsgBox "! Error The database connection fails or the occurrence of unexpected Error Number:" & Err.Number & ", the error message: "& Err.Description, vbInformation," remind you " 
End Sub

　　

 

Table name is the name of the database table

.