vb中将excel表导入到sql中相同结构的数据表中

做了一个管理软件，现在想实现导入导出功能，就是把客户信息表导入到相同结构的sql数据表中，同时也可以把数据库中的表格导出生成独立的excel表。有没有合适的控件，可以手动... 做了一个管理软件，现在想实现导入导出功能，就是把客户信息表导入到相同结构的sql数据表中，同时也可以把数据库中的表格导出生成独立的excel表。有没有合适的控件，可以手动选择存储地址，实现导入导出，最好能有详细代码。展开

 我来答

1个回答

#热议# 什么是淋病？哪些行为会感染淋病？

blademaster717
2013-10-12 · TA获得超过1456个赞

知道小有建树答主

回答量：882

采纳率：97%

帮助的人：370万

我也去答题访问个人页

关注

展开全部

下面是导入按钮COMMAND1_CLICK里面的代码
text4为显示读取文件路径的。
If Trim(Text4.Text) = "" Then
                MsgBox "请选择导入的路径！", vbInformation, Me.Caption
                Text4.SetFocus
                Exit Sub
            End If
            If MsgBox("确实要导入信息吗？", vbQuestion + vbYesNo, Me.Caption) = vbNo Then
                Exit Sub
            End If
            MousePointer = 11
            'EXCEL导入
            Call ImportZJZHXX(Trim(Text4.Text & "\文件名.xls"))

===========================

以下是导入的方法

'通过Excel导入数据库中
Private Function ImportZJZHXX(ByVal strExcelFile As String) As Boolean
    Dim ExcelApp As Excel.Application
    Dim ExcelSheet As Excel.Worksheet
    Dim sql As String
    Dim Hzrs As New ADODB.Recordset

Dim gcnData As ADODB.Connection

    Dim icount1 As Integer
    Dim i As Integer

   gcnData.Open "Provider=MSDAORA.1;Password=dzcs;User ID=dzcs;Data Source=ORCL_72.11"

On Error GoTo ErrHandler

    If strExcelFile = vbNullString Then
        MsgBox "没有Excel文件！", vbInformation, Me.Caption
        Exit Function
    End If

    Me.MousePointer = vbHourglass
    Set ExcelApp = CreateObject("Excel.Application")
    ExcelApp.Workbooks.Open FileName:=strExcelFile
    Set ExcelSheet = ExcelApp.ActiveSheet

    If ExcelSheet.UsedRange.Rows.Count > 1 Then
        Hzrs.Open "select * from JjHkXx where 1=2", gcnData, adOpenKeyset, adLockOptimistic
        For i = 2 To ExcelSheet.UsedRange.Rows.Count
                Hzrs.AddNew
                Hzrs!fsetcode = Trim(ExcelSheet.Cells(i, 1))

                Hzrs!FskDw = Trim(ExcelSheet.Cells(i, 2))
                Hzrs!FSkRen = Trim(ExcelSheet.Cells(i, 4))
                Hzrs!fskbank = Trim(ExcelSheet.Cells(i, 5))

                Hzrs.Update
                icount1 = icount1 + 1
        Next

        Hzrs.Close
    Else
        Me.MousePointer = vbDefault
        MsgBox "Excel文件中没有数据，请检查!", vbOKOnly + vbInformation, Me.Caption
        Exit Function
    End If

    ExcelApp.ActiveWorkbook.Close False
    ExcelApp.Quit
    Set ExcelSheet = Nothing
    Set ExcelApp = Nothing

    MsgBox "导入信息成功，总行数：" & icount1, vbOKOnly + vbInformation, Me.Caption

    Me.MousePointer = vbDefault
    ImportZJZHXX = True

    Exit Function

ErrHandler:
    If err.Number <> 0 Then
        MsgBox "导入信息失败，原因可能是：" & err.Description, vbOKOnly + vbInformation, Me.Caption
        Me.MousePointer = vbDefault
        ImportZJZHXX = False
    End If
End Function

本回答由提问者推荐