📄 frmmain3.frm

📁 教务管理系统,用VB 完成,以SQL SERVER 2000作为后台数据库
💻 FRM
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
      If recRepeat.RecordCount > 0 Then
          If MsgBox("您确定替换" & "" + Trim(recRepeat!XM) + "", vbInformation + vbOKCancel) = vbOK Then
              sqlDest = "delete * from " + Trim(REC) + " where xh='" + Trim(recSource!XH) + "'"
              Dbstudent.Execute sqlDest
              '复制余下数据
              recDest.AddNew
              For K = 1 To Number
                recDest.Fields(K).Value = recSource.Fields(K).Value
              Next K
              recDest.Update
          End If
      Else
          '复制余下数据
           recDest.AddNew
           For K = 1 To Number
             recDest.Fields(K).Value = recSource.Fields(K).Value
           Next K
           recDest.Update
      End If
    Next I
    MsgBox "导入数据成功!", vbInformation + vbOKOnly, "导入信息提示"
    Screen.MousePointer = 0
    Exit Sub
Else
    MsgBox "导入过程错误,请检查软盘是否插入软驱或软盘上是否有数据文件!", vbInformation + vbOKOnly, "导入信息提示"
    Exit Sub
End If
Screen.MousePointer = 0
End Sub

Public Sub CopyRecordXueH(ByVal REC As String, ByVal Number As Integer)
'生成recsourc表
On Error Resume Next
Dim recSource As Recordset
Dim sqlForCopy As String
Dim recDest As Recordset
Dim recRepeat As Recordset
Dim sqlDest As String
sqlForCopy = "select * from " + Trim(REC) + ""
Set recSource = dbOldStudent.OpenRecordset(sqlForCopy, dbOpenSnapshot)

If recSource.RecordCount > 0 Then
'处理重复数据并复制数据
    '读第一条记录
    recSource.MoveLast
    recSource.MoveFirst
    sqlDest = "select top 1 * from " + Trim(REC) + " where xueh='" + Trim(recSource!XueH) + "'"
    Set recRepeat = Dbstudent.OpenRecordset(sqlDest, dbOpenSnapshot)
    If recRepeat.RecordCount > 0 Then
        If MsgBox("您确定替换" & "" + Trim(recRepeat!XingM) + "", vbInformation + vbOKCancel) = vbOK Then
            sqlDest = "delete * from " + Trim(REC) + " where xueh='" + Trim(recSource!XueH) + "'"
            Dbstudent.Execute sqlDest
             '复制第一条记录
            Set recDest = Dbstudent.OpenRecordset("" + Trim(REC) + "")
            recDest.AddNew
            For K = 0 To Number - 1
              recDest.Fields(K).Value = recSource.Fields(K).Value
            Next K
            recDest.Update
        End If
    Else
        Set recDest = Dbstudent.OpenRecordset("" + Trim(REC) + "")
        recDest.AddNew
        For K = 0 To Number - 1
          recDest.Fields(K).Value = recSource.Fields(K).Value
        Next K
        recDest.Update
    End If
    '处理余下记录
    For I = 1 To recSource.RecordCount - 1
      recSource.MoveNext
      sqlDest = "select top 1 * from " + Trim(REC) + " where xueh='" + Trim(recSource!XueH) + "'"
      Set recRepeat = Dbstudent.OpenRecordset(sqlDest, dbOpenSnapshot)
      If recRepeat.RecordCount > 0 Then
          If MsgBox("您确定替换" & "" + Trim(recRepeat!XingM) + "", vbInformation + vbOKCancel) = vbOK Then
              sqlDest = "delete * from " + Trim(REC) + " where xueh='" + Trim(recSource!XueH) + "'"
              Dbstudent.Execute sqlDest
              '复制余下数据
              recDest.AddNew
              For K = 0 To Number - 1
                recDest.Fields(K).Value = recSource.Fields(K).Value
              Next K
              recDest.Update
          End If
      Else
          '复制余下数据
           recDest.AddNew
           For K = 0 To Number - 1
             recDest.Fields(K).Value = recSource.Fields(K).Value
           Next K
           recDest.Update
      End If
    Next I
    MsgBox "导入数据成功", vbInformation, "导入信息提示"
    Screen.MousePointer = 0
    Exit Sub
Else
    MsgBox "导入过程错误,请检查软盘是否插入软驱或软盘上是否有数据文件!", vbInformation + vbOKOnly, "导入信息提示"
    Exit Sub
End If
Screen.MousePointer = 0
End Sub


'导出函数
Public Sub CopyRecordXHO(ByVal REC As String, ByVal Number As Integer)
'生成recsourc表
On Error Resume Next
Dim sqlForCopy As String
Dim recSource As Recordset
Dim recDest As Recordset
Dim recRepeat As Recordset
Dim sqlDest As String
sqlForCopy = "select * from " + Trim(REC) + ""
Set recSource = Dbstudent.OpenRecordset(sqlForCopy, dbOpenSnapshot)

If recSource.RecordCount > 0 Then
'处理重复数据并复制数据
    '读第一条记录
    recSource.MoveLast
    recSource.MoveFirst
    sqlDest = "select top 1 * from " + Trim(REC) + " where xh='" + Trim(recSource!XH) + "'"
    Set recRepeat = Dbstudent.OpenRecordset(sqlDest, dbOpenSnapshot)
    If recRepeat.RecordCount > 0 Then
        If MsgBox("您确定替换" & "" + Trim(recRepeat!XM) + "", vbInformation + vbOKCancel) = vbOK Then
            sqlDest = "delete * from " + Trim(REC) + " where xh='" + Trim(recSource!XH) + "'"
            Dbstudent.Execute sqlDest
             '复制第一条记录
            Set recDest = Dbstudent.OpenRecordset("" + Trim(REC) + "")
            recDest.AddNew
            For K = 1 To Number
              recDest.Fields(K).Value = recSource.Fields(K).Value
            Next K
            recDest.Update
        End If
    Else
        Set recDest = Dbstudent.OpenRecordset("" + Trim(REC) + "")
        recDest.AddNew
        For K = 1 To Number
          recDest.Fields(K).Value = recSource.Fields(K).Value
        Next K
        recDest.Update
    End If
    '处理余下记录
    For I = 1 To recSource.RecordCount - 1
      recSource.MoveNext
      sqlDest = "select top 1 * from " + Trim(REC) + " where xh='" + Trim(recSource!XH) + "'"
      Set recRepeat = Dbstudent.OpenRecordset(sqlDest, dbOpenSnapshot)
      If recRepeat.RecordCount > 0 Then
          If MsgBox("您确定替换" & "" + Trim(recRepeat!XM) + "", vbInformation + vbOKCancel) = vbOK Then
              sqlDest = "delete * from " + Trim(REC) + " where xh='" + Trim(recSource!XH) + "'"
              Dbstudent.Execute sqlDest
              '复制余下数据
              recDest.AddNew
              For K = 1 To Number
                recDest.Fields(K).Value = recSource.Fields(K).Value
              Next K
              recDest.Update
          End If
      Else
          '复制余下数据
           recDest.AddNew
           For K = 1 To Number
             recDest.Fields(K).Value = recSource.Fields(K).Value
           Next K
           recDest.Update
      End If
    Next I
    MsgBox "导入成功", vbCritical
End If
    
End Sub

Public Sub CopyRecordXueHO(ByVal REC As String, ByVal Number As Integer)
'生成recsourc表
On Error Resume Next
Dim recSource As Recordset
Dim sqlForCopy As String
Dim recDest As Recordset
Dim recRepeat As Recordset
Dim sqlDest As String
sqlForCopy = "select * from " + Trim(REC) + ""
Set recSource = dbOldStudent.OpenRecordset(sqlForCopy, dbOpenSnapshot)

If recSource.RecordCount > 0 Then
'处理重复数据并复制数据
    '读第一条记录
    recSource.MoveLast
    recSource.MoveFirst
    sqlDest = "select top 1 * from " + Trim(REC) + " where xueh='" + Trim(recSource!XueH) + "'"
    Set recRepeat = Dbstudent.OpenRecordset(sqlDest, dbOpenSnapshot)
    If recRepeat.RecordCount > 0 Then
        If MsgBox("您确定替换" & "" + Trim(recRepeat!XingM) + "", vbInformation + vbOKCancel) = vbOK Then
            sqlDest = "delete * from " + Trim(REC) + " where xueh='" + Trim(recSource!XueH) + "'"
            Dbstudent.Execute sqlDest
             '复制第一条记录
            Set recDest = Dbstudent.OpenRecordset("" + Trim(REC) + "")
            recDest.AddNew
            For K = 0 To Number - 1
              recDest.Fields(K).Value = recSource.Fields(K).Value
            Next K
            recDest.Update
        End If
    Else
        Set recDest = Dbstudent.OpenRecordset("" + Trim(REC) + "")
        recDest.AddNew
        For K = 0 To Number - 1
          recDest.Fields(K).Value = recSource.Fields(K).Value
        Next K
        recDest.Update
    End If
    '处理余下记录
    For I = 1 To recSource.RecordCount - 1
      recSource.MoveNext
      sqlDest = "select top 1 * from " + Trim(REC) + " where xueh='" + Trim(recSource!XueH) + "'"
      Set recRepeat = Dbstudent.OpenRecordset(sqlDest, dbOpenSnapshot)
      If recRepeat.RecordCount > 0 Then
          If MsgBox("您确定替换" & "" + Trim(recRepeat!XingM) + "", vbInformation + vbOKCancel) = vbOK Then
              sqlDest = "delete * from " + Trim(REC) + " where xueh='" + Trim(recSource!XueH) + "'"
              Dbstudent.Execute sqlDest
              '复制余下数据
              recDest.AddNew
              For K = 0 To Number - 1
                recDest.Fields(K).Value = recSource.Fields(K).Value
              Next K
              recDest.Update
          End If
      Else
          '复制余下数据
           recDest.AddNew
           For K = 0 To Number - 1
             recDest.Fields(K).Value = recSource.Fields(K).Value
           Next K
           recDest.Update
      End If
    Next I
    MsgBox "导入成功", vbCritical
End If
    
End Sub


Public Sub CopyRecordOut0(ByVal REC As String, ByVal Number As Integer)
'生成recsourc表
On Error Resume Next
Dim sqlForCopy As String
Dim recSource As Recordset
Dim recDest As Recordset

sqlForCopy = "select * from " + Trim(REC) + ""
Set recSource = Dbstudent.OpenRecordset(sqlForCopy, dbOpenSnapshot)

'删去所有数据
Set dbOldStudent = OpenDatabase("a:\student.mdb", False, False)
sqlForCopy = "delete * from " + Trim(REC) + ""
dbOldStudent.Execute sqlForCopy

If recSource.RecordCount > 0 Then

    '读第一条记录并复制
    recSource.MoveLast
    recSource.MoveFirst
    Set recDest = dbOldStudent.OpenRecordset("" + Trim(REC) + "")
    recDest.AddNew
    For K = 1 To Number
      recDest.Fields(K).Value = recSource.Fields(K).Value
    Next K
    recDest.Update
    
    '处理余下记录
    For I = 1 To recSource.RecordCount - 1
      recSource.MoveNext
      recDest.AddNew
      For K = 1 To Number
        recDest.Fields(K).Value = recSource.Fields(K).Value
      Next K
      recDest.Update
    Next I
    
    MsgBox "数据导出成功！", vbInformation, "导出信息提示"
    
End If
dbOldStudent.Close
End Sub


Public Sub CopyRecordOut1(ByVal REC As String, ByVal Number As Integer)
'生成recsourc表
On Error Resume Next
Dim sqlForCopy As String
Dim recSource As Recordset
Dim recDest As Recordset

sqlForCopy = "select * from " + Trim(REC) + ""
Set recSource = Dbstudent.OpenRecordset(sqlForCopy, dbOpenSnapshot)

'删去所有数据
Set dbOldStudent = OpenDatabase("a:\student.mdb", False, False)
sqlForCopy = "delete * from " + Trim(REC) + ""
dbOldStudent.Execute sqlForCopy

If recSource.RecordCount > 0 Then

    '读第一条记录并复制
    recSource.MoveLast
    recSource.MoveFirst
    Set recDest = dbOldStudent.OpenRecordset("" + Trim(REC) + "")
    recDest.AddNew
    For K = 0 To Number - 1
      recDest.Fields(K).Value = recSource.Fields(K).Value
    Next K
    recDest.Update
    
    '处理余下记录
    For I = 1 To recSource.RecordCount - 1
      recSource.MoveNext
      recDest.AddNew
      For K = 0 To Number - 1
        recDest.Fields(K).Value = recSource.Fields(K).Value
      Next K
      recDest.Update
    Next I
    
    MsgBox "导出成功", vbCritical
   
End If
dbOldStudent.Close
End Sub
Function FileExists(ByVal FileName As String) As Integer
Dim temp$
    FileExists = True
On Error Resume Next
    temp$ = FileDateTime(FileName)
    Select Case err
        Case 53, 76, 68   'File Does Not Exist
            FileExists = False
            err = 0
        Case Else
            If err <> 0 Then
                'MsgBox "导入过程出错，请检查软盘是否插入软驱中！", vbExclamation, "出错信息提示"
                'end
            End If
    End Select
End Function

Private Sub MNUXXKC_Click()
FRMXXKC.Show 1
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Index
    Case 1
    Call MNUEXIT_Click
    Case 3
    Call MNUBASE1_Click
    Case 4
    Call MNUBASE2_Click
    Case 5
    Call MNUBASE3_Click
    Case 6
    Call MNUBASE4_Click
    Case 8
    Call MNUMARKADD_Click
    Case 9
    Call MNUMARK1_Click
    End Select
End Sub
上一页 1 23
💿 文件大小 2466 K
👤 上传用户 baorong216
📂 所属分类 SQL Server
🏷️ 相关标签

#SERVER #2000 #SQL #管理系统
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -