nodetree.cls

哈哈

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "nodetree"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Description = "记录点击被选队列的情况"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'保持属性值的局部变量
Private mvarchoosenode As String '局部复制
Private mvarchoosefront As String '局部复制
Private mvarnodekey As String '局部复制
Private mvarnodechild As Integer '局部复制
Private mExl As Excel.Application
Private mSheet As Excel.Worksheet
Private mWorkBook As Excel.Workbook
Public Property Let nodechild(ByVal vData As Integer)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.nodechild = 5
    mvarnodechild = vData
End Property


Public Property Get nodechild() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.nodechild
    nodechild = mvarnodechild
End Property



Public Property Let nodekey(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.nodekey = 5
    mvarnodekey = vData
End Property


Public Property Get nodekey() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.nodekey
    nodekey = mvarnodekey
End Property



Public Property Let choosefront(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.choosefront = 5
    mvarchoosefront = vData
End Property


Public Property Get choosefront() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.choosefront
    choosefront = mvarchoosefront
End Property



Public Property Let choosenode(ByVal vData As String)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.choosenode = 5
    mvarchoosenode = vData
End Property


Public Property Get choosenode() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.choosenode
    choosenode = mvarchoosenode
End Property
Function importdata(ByVal DataPath As String) As Integer
    On Error GoTo chuli:
    
     Dim Fir_F As String
     Dim Sen_F As String
     Dim Thi_F As String
     Dim rs_Count As Integer
     Dim CurRow As Long, CurCol As Long
     Dim con As New ADODB.Connection
     Dim rs As New ADODB.Recordset
     Dim tempvar(4) As String
     Dim tempFild(4) As String
     Dim BooTmp As Boolean
     Dim i As Integer
     CurRow = 2
     CurCol = 1
     rs_Count = 0
     BooTmp = True
     Set mExl = New Excel.Application

        With mExl
            Set mWorkBook = .Workbooks.Open(DataPath)
            Set mSheet = mWorkBook.Sheets("sheet1")
        End With
    For i = 1 To 4
        tempFild(i) = mSheet.Cells(1, i)
    Next i
    If tempFild(1) = "" Or tempFild(2) = "" Or tempFild(3) = "" Or tempFild(4) = "" Then
        MsgBox "在数据源的第一行没有发现数据字段", vbOKOnly + 48, "警告"
        BooTmp = False
    Else
        con.ConnectionString = pubconnstr
        con.Open
        rs.Open "select * from import", con, adOpenKeyset, adLockOptimistic
        While BooTmp = True
            For CurCol = 1 To 4
                tempvar(CurCol) = mSheet.Cells(CurRow, CurCol)
                If Len(tempvar(CurCol)) = 0 And Trim(tempFild(CurCol)) = "学号" Then
                    BooTmp = False
                    Exit For
                End If
                If IsNull(tempvar(CurCol)) Then
                    BooTmp = False
                    Exit For
                End If
            Next
            If BooTmp = True Then
            rs.AddNew
            For i = 1 To 4
                rs.Fields(Trim(tempFild(i))) = tempvar(i)
            Next
            
                rs.Update
            
            rs_Count = rs_Count + 1
            CurRow = CurRow + 1
            End If

    import.jindu.Value = import.jindu.Value + 1
    If import.jindu.Value = import.jindu.Max Then
         import.jindu.Visible = False
         import.jindu.Value = 0
    End If
    Wend
    End If

    mExl.Quit
    Set mSheet = Nothing
    Set mWorkBook = Nothing
    Set mExl = Nothing
    importdata = rs_Count
    rs.close
    Set rs = Nothing

    con.close
    Set con = Nothing
chuli:
    If Err.Number > 0 Then
    MsgBox Err.Number & Err.Description
    End If
End Function
Function importexam(ByVal DataPath As String) As Integer
    On Error GoTo Errinfor
    Dim Fir_F As String
     Dim Sen_F As String
     Dim Thi_F As String
     Dim rs_Count As Integer
     Dim CurRow As Long, CurCol As Long
     Dim con As New ADODB.Connection
     Dim rs As New ADODB.Recordset
     Dim tempvar(4) As String
     Dim tempFild(4) As String
     Dim BooTmp As Boolean
     Dim Tmpstr As String
     Dim i As Integer
     CurRow = 2
     CurCol = 1
     rs_Count = 0
     BooTmp = True
     Set mExl = New Excel.Application

        With mExl
            Set mWorkBook = .Workbooks.Open(DataPath)
            Set mSheet = mWorkBook.Sheets("sheet1")
        End With
    For i = 1 To 3
        tempFild(i) = mSheet.Cells(1, i)
    Next i
    If Trim(tempFild(1)) = "" Or Trim(tempFild(2)) = "" Or Trim(tempFild(3)) = "" Then
        MsgBox "在数据源的第一行没有发现数据字段", vbOKOnly + 48, "警告"
        BooTmp = False
    Else
        con.ConnectionString = pubconnstr
        con.Open
        rs.Open "select * from exam", con, adOpenKeyset, adLockOptimistic
        While BooTmp = True
            For CurCol = 1 To 3
                tempvar(CurCol) = mSheet.Cells(CurRow, CurCol)
                If Trim(tempFild(CurCol)) = "考场名称" Then
                    If Trim(tempvar(CurCol)) = "" Then
                        BooTmp = False
                    Else
                        Tmpstr = tempvar(CurCol)
                        tempvar(CurCol) = ConClass(Left(Tmpstr, Len(Tmpstr) - 2)) & Right(Tmpstr, 2)
                    End If
                End If
                If Trim(tempFild(CurCol)) = "考场人数" Then
                    If Trim(tempvar(CurCol)) = "" Then
                        BooTmp = False
                    Else
                        tempvar(CurCol) = CStr(Trim(tempvar(CurCol)))
                    End If
                End If
            Next
            If BooTmp = True Then
            rs.AddNew
            For i = 1 To 3
                rs.Fields(tempFild(i)) = Trim(tempvar(i))
            Next
            rs.Update
            rs_Count = rs_Count + 1
            CurRow = CurRow + 1
            End If
    Wend
    End If
    
    mExl.Quit
    Set mSheet = Nothing
    Set mWorkBook = Nothing
    Set mExl = Nothing
    importexam = rs_Count
      rs.close
    Set rs = Nothing

    con.close
    Set con = Nothing
Errinfor:
    If Err.Number = "13" Then
    End If
    If Err.Number = -2147217887 Then
        MsgBox "发现重复记录!", vbOKOnly + 48, "错误提示"
    End If
End Function