VB

drong_yang

各位有没有用vb编写的界面，把excel数据导入到sql server中呀

smthgdin

sqlserver本身就有这个功能阿，为何要重新写一个？

happynight

原帖由 smthgdin 于 2008-3-20 16:04 发表
sqlserver本身就有这个功能阿，为何要重新写一个？

给用户使用不可能让用户直接操作SQL吧

smthgdin

创建两个连接1个连接sqlserver1个连接excel文档。
读取文档数据，放到dataset中，循环insert进数据库。

happynight

给你部分代码吧
---------------------------------------------------------------------------------------------------------------------------------------
Private Sub cmdDataIn_Click()
    On Error GoTo Err
   
    Dim CnnExcel As New ADODB.Connection
    Dim rstIn As New ADODB.Recordset
    Dim cmdUpdate As New ADODB.Command
    Dim strDate As String
    Dim intCurrent As Integer                   \'用来控制导入的数据规模,当数据较大时,将一张单分拆成多张每张数量不超过1000的单据
    Dim intFirst As Integer                     \'记录本次导入中,第一张单的批号,用来在刷新数据时用到
   
    If Trim(cmbTable.Text) = \"\" Then RaiseErr \"请选择要导入的WorkSheet\"
    intBatchCode = BuildBatchCode   \'获得批号
    intFirst = intBatchCode
    Label1.Caption = \"资料导入中....\"
    Label1.Visible = True
    DoEvents
    If ConnectDataSource(ConnectEXCEL, Trim(txtIn.Text), \"\", \"\", \"\", CnnExcel) = False Then RaiseErr \"连接Excel文件失败\"
    With rstIn
         .ActiveConnection = CnnExcel
         .CursorLocation = adUseClient
         .CursorType = adOpenForwardOnly
         .LockType = adLockReadOnly
         .Source = \"SELECT 料号,品名,规格,长度,宽度,单位,产品型号,级别,颜色,备注 FROM [\" & Trim(cmbTable.Text) & \"] WHERE 料号 IS NOT NULL\"
         .Open
    End With   
    strDate = Format(Now, \"YYYY-MM-DD\")
   
    With cmdUpdate
         .ActiveConnection = cnn
         .CommandType = adCmdText
        Do Until rstIn.EOF
           If intCurrent = 1000 Then
              intCurrent = 0
              intBatchCode = BuildBatchCode
           End If
           .CommandText = \" INSERT INTO tblDataIN VALUES(\'\" & rstIn!料号 & \"\',\'\" & rstIn!品名 & \"\',\'\" & rstIn!规格 & \"\',\" _
                        & rstIn!长度 & \",\" & IIf(IsNull(rstIn!宽度), \"NULL\", rstIn!宽度) & \",\'\" & rstIn!单位 & \"\',\'\" & rstIn!产品型号 & \"\',\'\" & rstIn!级别 & \"\',\'\" _
                        & rstIn!颜色 & \"\',\'\" & rstIn!备注 & \"\',\'\" & strDate & \"\',\" & intBatchCode & \",NULL,NULL)\"
           .Execute
           intCurrent = intCurrent + 1
           rstIn.MoveNext
        Loop
    End With
   
    fraDataIn.Visible = False
    CnnExcel.Close
    Label1.Visible = False
    Label1.Caption = \"\"
   
    If intFirst = intCurrent Then
       RefreshDataView \"SELECT DISTINCT 资料导入日期,批次 FROM tblDataIn WHERE 资料导入日期=\'\" & strDate & \"\' AND 批次=\" & intBatchCode
    Else
       RefreshDataView \"SELECT DISTINCT 资料导入日期,批次 FROM tblDataIn WHERE 资料导入日期=\'\" & strDate & \"\' AND 批次<=\" & intBatchCode
    End If
   
Err:
    If Err.Number <> 0 Then MsgBox \"数据导入失败,因为:\" & Err.Description, vbOKOnly, \"系统提示\"
    If IsObject(CnnExcel) Then Set CnnExcel = Nothing
    If IsObject(rstIn) Then Set rstIn = Nothing
End Sub
---------------------------------------------------------------------------------------------------------------------------------------
Public Function ConnectDataSource(CurrentConnect As ConnectType, strDataBase As String, strServer As String, strUser As String, strPwd As String, MyConnection As ADODB.Connection, Optional CurrentVer As DBVersion = UnKnow) As Boolean
   \'功能:用来连接数据源
   On Error GoTo Err
   \'CurrentVer:数据源版本;
   \'CurrentConnect:数据源类别
   \'strDataBase:数据库
   \'strServer:服务器
   \'strUser:用户名
   \'strPwd:密码
   \'MyConnection:用来接收生成的连接
   \'注：本函数只能生成ADO的连接,且功能未完善,待完善---还未测试完
   Dim strCnn As String
   Select Case CurrentConnect
          Case ConnectEXCEL                          \'数据源是EXCEL
               Select Case CurrentVer
                      Case EXCEL2000, UnKnow         \'默认情况下使用2000版本
                           strCnn = \"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\" & strDataBase & \";Extended Properties=Excel 8.0\"
               End Select
          Case ConnectACCESS                         \'数据源是ACCESS
          Case ConnectSQL                            \'数据源是SQL SERVER
          Case ConnectINFORMIX                       \'数据源是INFORMIX
          Case Else
   End Select
   MyConnection.Open strCnn
   ConnectDataSource = True
   
Err:
   If Err.Number <> 0 Then
      MsgBox \"数据库连接失败,因为:\" & Err.Description
      ConnectDataSource = False    \'返回失败信号
   End If
   
End Function
---------------------------------------------------------------------------------------------------------------------------------------
Public Enum ConnectType
        ConnectSQL = 1                        \'连接SQL SERVER
        ConnectEXCEL = 2                      \'连接EXCEL
        ConnectACCESS = 3                     \'连接ACCESS
        ConnectINFORMIX = 4                   \'连接Informix
End Enum

smthgdin

楼上还有现成代码阿。：）

wghao

如happynight 兄弟那样写，使用ADO很方便。
up

DragonBill

都是自己写的, 网上好像没有找到

drong_yang

看了你代码，但是我的不能运行，有没有完整的代码，可提参考呀

非常感谢！