昨晚更新了一下Excel to MSSQL,基本達到要求.

VBA已經更新,基本達到要求,記錄一下(還將更新).
Last updated 18/Feb/2006


commandbutton1用於下載
commandbutton2刪除資料
commandbutton3更新

Private Sub CommandButton1_Click()
''Application.DisplayFullScreen = True
''Application.CommandBars("Full Screen").Enabled = False
''Application.CommandBars.ActiveMenuBar.Enabled = False
''Application.CommandBars.ActiveMenuBar.Enabled = True

Sheet1.CommandButton3.Enabled = True
Sheet1.CommandButton1.Caption = "RnImport"

Dim cnpubs As adodb.Connection
Set cnpubs = New adodb.Connection
Dim strConn As String
strConn = "PROVIDER=SQLOLEDB;"
strConn = strConn & "DATA SOURCE=ibm3000;INITIAL CATALOG=idd;Uid=sa;Pwd=sa"
cnpubs.Open strConn

Dim rsPubs As adodb.Recordset
Set rsPubs = New adodb.Recordset

     With rsPubs
   
          .ActiveConnection = cnpubs
          .Open "SELECT * FROM idd_test"
         
          Sheet1.Range("a3", "iv65535").Delete
          Sheet1.Range("A3").CopyFromRecordset rsPubs
          .Close
     End With

cnpubs.Close
Set rsPubs = Nothing
Set cnpubs = Nothing
           



End Sub

Private Sub CommandButton2_Click()
Sheet1.CommandButton1.Caption = "Import"
Sheet1.CommandButton3.Enabled = False
Sheet1.Range("a3", "iv65535").Delete
End Sub

Private Sub CommandButton3_Click()
ThisWorkbook.SaveCopyAs Filename:="c:ackup_ibm3000_idd_test.xls"
Dim MyVar
    MyVar = MsgBox("ALL DATA in the MSSQL will be cover for.", 3 + vbQuestion, "WARNING!")
   If MyVar = vbYes Then

Dim R As String
Dim cnpubs As adodb.Connection
Set cnpubs = New adodb.Connection
Dim strConn As String
strConn = "PROVIDER=SQLOLEDB;"
strConn = strConn & "DATA SOURCE=ibm3000;INITIAL CATALOG=idd;Uid=sa;Pwd=sa"
cnpubs.Open strConn
Dim rsPubs As adodb.Recordset
Set rsPubs = New adodb.Recordset

rsPubs.ActiveConnection = cnpubs
rsPubs.Open "delete from idd_test"

R = 3
    Do While Len(Range("A" & R).Formula) > 0


        With rsPubs
       
            .ActiveConnection = cnpubs
            .Open "idd_test", cnpubs, adOpenKeyset, adLockOptimistic, adCmdTable
             .AddNew
            .Fields("company_code") = Range("A" & R).Value
            .Fields("user_code") = Range("B" & R).Value
            .Fields("user_name") = Range("C" & R).Value
            .Fields("extension") = Range("D" & R).Value
            .Fields("department") = Range("E" & R).Value
            .Fields("remark") = Range("F" & R).Value
            .Fields("created_by") = Range("G" & R).Value
            .Fields("create_datetime") = Range("H" & R).Value
            .Fields("modified_by") = Range("I" & R).Value
            .Fields("modify_datetime") = Range("J" & R).Value
            .Fields("suspended_flag") = Range("K" & R).Value
            ''''.Fields("") = Range().Value
            ''''.Fields("") = Range().Value
            ''''.Fields("") = Range().Value
            ''''.Fields("") = Range().Value
            ''''.Fields("") = Range().Value
            ''''.Fields("") = Range().Value
            ''''.Fields("") = Range().Value
            ''''.Fields("") = Range().Value
         
            .Update
            .Close
        End With
        R = R + 1
    Loop

cnpubs.Close
Set rsPubs = Nothing
Set cnpubs = Nothing
   

Else

End If

Kill "c:ackup_ibm3000_idd_test.xls"
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
''''Sheet1.Range("a3", "iv65535").Delete
End Sub

Private Sub Workbook_Open()
Sheet1.Range("a3", "iv65535").Delete
Sheet1.CommandButton3.Enabled = False
Sheet1.CommandButton1.Caption = "Import"


End Sub
 

'*******************************************************************

'Last edit 18/Feb/2006

 

''program notes:

''Sheet2.Range("a65536") = ComboBox1.Text  -->SQL Server
''Sheet2.Range("b65536") = ComboBox2.Text  -->Database
''Sheet2.Range("c65536") = ComboBox3.Text  -->Usertable
''Sheet2.Range("d65536") = TextBox1.Text   -->Uid
''Sheet2.Range("e65536") = TextBox2.Text   -->PWD
''commandbutton1   -->Import DATA
''commandbutton2   -->Canle
''commandbutton3   -->Connect SQL
''commandbutton4   -->Move all item:listbox1-->listbox2
''commandbutton5   -->Move all item:listbox2-->listbox1
''combobox1:SQL Server
''combobox2:Database
''combobox3:Table