datainfrm.frm

一个关于进销存的源代码

                            '循环xls数据表,进行逐行添加
                            Do While Not rdst.EOF
                            Dim ardst As New ADODB.Recordset
                            ardst.Open "select * from " & mdbname & " where 村='" & rdst.Fields(3).Value & "'and 序号='" & rdst.Fields(4).Value & "'", g_conn
                       If ardst.EOF = True Then
                            Dim i As Integer
                            Dim xlsvalue As String
                            xlsvalue = ""
                            For i = 1 To mdbcols
                               If IsNull(rdst.Fields(i - 1).Value) = True Then
                                  xlsvalue = xlsvalue & "'0'" & ","
                               Else
                                  xlsvalue = xlsvalue & "'" & rdst.Fields(i - 1).Value & "'" & ","
                               End If
                            Next i
                            xlsvalue = Left(xlsvalue, Len(xlsvalue) - 1)
                           Debug.Print xlsvalue
                           '打开mdb进行追加
                            Dim rdst2 As New ADODB.Recordset
                            rdst2.Open "insert into " & mdbname & " values(" & xlsvalue & ")", g_conn
                          Else
                                Dim dr As New ADODB.Recordset
                                  dr.Open "delete * from " & mdbname & " where 村='" & rdst.Fields(3).Value & "'and 序号='" & rdst.Fields(4).Value & "'", g_conn
                                  Set dr = Nothing
                                           xlsvalue = ""
                                             For i = 1 To mdbcols
                                                If IsNull(rdst.Fields(i - 1).Value) = True Then
                                                   xlsvalue = xlsvalue & "'0'" & ","
                                                Else
                                                   xlsvalue = xlsvalue & "'" & rdst.Fields(i - 1).Value & "'" & ","
                                                End If
                                             Next i
                                             xlsvalue = Left(xlsvalue, Len(xlsvalue) - 1)
                                            '打开mdb进行追加
                                             rdst2.Open "insert into " & mdbname & " values(" & xlsvalue & ")", g_conn
                            End If
                            Set ardst = Nothing
                            rdst.MoveNext
                        Loop
                            killmore (mdbname)
                            Set rdst = Nothing
                            Set rdst2 = Nothing
                            Set rdst3 = Nothing
                            xlsname = ""
                            mdbname = ""
                            mdbcols = 0
                            Text1.Text = ""
                            datain_conn.Close
                            MsgBox "导入完成", vbOKOnly, "数据导入完成"
                            Exit Sub
                            End If
        Case Is = 6
                            If Text1.Text = "" Then
                                 MsgBox "请选择*.xls数据", vbOKOnly, "数据导入操作"
                            Exit Sub
                            Else
                            'mdbname = dhfrm.List1.list(dhfrm.List1.ListIndex)
                            'Dim rdst3 As New ADODB.Recordset
                            rdst3.Open "select * from tablename where fid = " & dhfrm.List1.ListIndex + 1 & "", g_conn
                                    mdbname = rdst3!表名
                                    mdbcols = rdst3!列数
                           'CommonDialog1.Flags = cdlOFNAllowMultiselect  单选多选
                           '连接*.xls文件
                            datain_conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & xlsname & ""
                            '打开*.xls文件
                            'Dim rdst As New ADODB.Recordset
                            rdst.Open "select * from [a$]", datain_conn
                            '循环xls数据表,进行逐行添加
                            Do While Not rdst.EOF
                            'Dim ardst As New ADODB.Recordset
                            ardst.Open "select * from " & mdbname & " where 区='" & rdst.Fields(1).Value & "'and 序号='" & rdst.Fields(3).Value & "'", g_conn
                       If ardst.EOF = True Then
                            'Dim i As Integer
                            'Dim xlsvalue As String
                            xlsvalue = ""
                            For i = 1 To mdbcols
                               If IsNull(rdst.Fields(i - 1).Value) = True Then
                                  xlsvalue = xlsvalue & "'0'" & ","
                               Else
                                  xlsvalue = xlsvalue & "'" & rdst.Fields(i - 1).Value & "'" & ","
                               End If
                            Next i
                            xlsvalue = Left(xlsvalue, Len(xlsvalue) - 1)
                           Debug.Print xlsvalue
                           '打开mdb进行追加
                            'Dim rdst2 As New ADODB.Recordset
                            rdst2.Open "insert into " & mdbname & " values(" & xlsvalue & ")", g_conn
                          Else
                             '   Dim dr As New ADODB.Recordset
                                  dr.Open "delete * from " & mdbname & " where 区='" & rdst.Fields(1).Value & "'and 序号='" & rdst.Fields(3).Value & "'", g_conn
                                  Set dr = Nothing
                                           xlsvalue = ""
                                             For i = 1 To mdbcols
                                                If IsNull(rdst.Fields(i - 1).Value) = True Then
                                                   xlsvalue = xlsvalue & "'0'" & ","
                                                Else
                                                   xlsvalue = xlsvalue & "'" & rdst.Fields(i - 1).Value & "'" & ","
                                                End If
                                             Next i
                                             xlsvalue = Left(xlsvalue, Len(xlsvalue) - 1)
                                            '打开mdb进行追加
                                             rdst2.Open "insert into " & mdbname & " values(" & xlsvalue & ")", g_conn
                            End If
                            Set ardst = Nothing
                            rdst.MoveNext
                        Loop
                            killmore (mdbname)
                            Set rdst = Nothing
                            Set rdst2 = Nothing
                            Set rdst3 = Nothing
                            xlsname = ""
                            mdbname = ""
                            mdbcols = 0
                            Text1.Text = ""
                            datain_conn.Close
                            MsgBox "导入完成", vbOKOnly, "数据导入完成"
                            Exit Sub
                            End If
        
        
        Case Is > 6
                            If Text1.Text = "" Then
                                MsgBox "请选择*.xls数据", vbOKOnly, "数据导入操作"
                            Exit Sub
                            Else
                            'mdbname = dhfrm.List1.list(dhfrm.List1.ListIndex)
                            'Dim rdst3 As New ADODB.Recordset
                            rdst3.Open "select * from tablename where fid = " & dhfrm.List1.ListIndex + 1 & "", g_conn
                            mdbname = rdst3!表名
                            mdbcols = rdst3!列数
                           'CommonDialog1.Flags = cdlOFNAllowMultiselect  单选多选
                           '连接*.xls文件
                            datain_conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & xlsname & ""
                            '打开*.xls文件
                            'Dim rdst As New ADODB.Recordset
                            rdst.Open "select * from [a$]", datain_conn
                            '循环xls数据表,进行逐行添加
                            Do While Not rdst.EOF
                            'Dim ardst As New ADODB.Recordset
                            ardst.Open "select * from " & mdbname & " where 区='" & rdst.Fields(1).Value & "'and 序号='" & rdst.Fields(2).Value & "'", g_conn
                       If ardst.EOF = True Then
                            'Dim i As Integer
                            'Dim xlsvalue As String
                            xlsvalue = ""
                            For i = 1 To mdbcols
                               If IsNull(rdst.Fields(i - 1).Value) = True Then
                                  xlsvalue = xlsvalue & "'0'" & ","
                               Else
                                  xlsvalue = xlsvalue & "'" & rdst.Fields(i - 1).Value & "'" & ","
                               End If
                            Next i
                            xlsvalue = Left(xlsvalue, Len(xlsvalue) - 1)
                           Debug.Print xlsvalue
                           '打开mdb进行追加
                            'Dim rdst2 As New ADODB.Recordset
                            rdst2.Open "insert into " & mdbname & " values(" & xlsvalue & ")", g_conn
                          Else
                             '   Dim dr As New ADODB.Recordset
                                  dr.Open "delete * from " & mdbname & " where 区='" & rdst.Fields(1).Value & "'and 序号='" & rdst.Fields(2).Value & "'", g_conn
                                  Set dr = Nothing
                                           xlsvalue = ""
                                             For i = 1 To mdbcols
                                                If IsNull(rdst.Fields(i - 1).Value) = True Then
                                                   xlsvalue = xlsvalue & "'0'" & ","
                                                Else
                                                   xlsvalue = xlsvalue & "'" & rdst.Fields(i - 1).Value & "'" & ","
                                                End If
                                             Next i
                                             xlsvalue = Left(xlsvalue, Len(xlsvalue) - 1)
                                            '打开mdb进行追加
                                             rdst2.Open "insert into " & mdbname & " values(" & xlsvalue & ")", g_conn
                            End If
                            Set ardst = Nothing
                            rdst.MoveNext
                        Loop
                            killmore (mdbname)
                            Set rdst = Nothing
                            Set rdst2 = Nothing
                            Set rdst3 = Nothing
                            xlsname = ""
                            mdbname = ""
                            mdbcols = 0
                            Text1.Text = ""
                            datain_conn.Close
                            MsgBox "导入完成", vbOKOnly, "数据导入完成"
                            Exit Sub
                            End If

    End Select
err1:
    MsgBox "数据错误,请检查xls文件", vbOKOnly, "数据导入操作"
End Sub
Private Sub Form_Load()
        askn.ApplySkin Me.hWnd
        Me.Left = 6000
        Me.Top = 3000
        Me.Width = Frame1.Width + 100
        Me.Height = Frame1.Height + 1000
        Me.Caption = dhfrm.List1.list(dhfrm.List1.ListIndex) & "   数据导入"
End Sub
Sub killmore(mdbname As String)
On Error Resume Next
        Dim rdst As New ADODB.Recordset
            rdst.Open "delete * from " & mdbname & " where 市 ='0' or 序号 ='0'", g_conn
        Set rdst = Nothing
End Sub