m4.bas

办公自动化 vb+server2

Attribute VB_Name = "备份"
Public Sub beifen1(username As String, MenuItem As Long)
Dim gfm As String  'gfm变量用来获取用户输入的文件名
Dim a, i, j, m As Integer
a = 0
     Form2.ListView2(0).ListItems.Clear
     Form2.ListView2(1).ListItems.Clear
     Form2.ListView2(2).ListItems.Clear
     Form2.ListView2(3).ListItems.Clear
     Form2.ListView2(4).ListItems.Clear
     Form2.ListView2(5).ListItems.Clear
     Form2.ListView2(6).ListItems.Clear
For Each mytab In cat.Tables
  lty11 = mytab.Name
   lty12 = left(lty11, 2)
   If lty12 <> "sy" And lty12 <> "dt" And lty12 <> "密码" And lty12 <> "工程" And lty12 <> "记事" Then
       a = a + 1
   rs.CursorLocation = adUseClient
   rs.Open lty11, conn, adOpenKeyset, adLockPessimistic
    For i = 1 To rs.RecordCount
      Form2.ListView2(a - 1).ListItems.Add , , rs.Fields(0).Value
     For j = 1 To 16
      Form2.ListView2(a - 1).ListItems.Item(i).SubItems(j) = rs.Fields(j).Value
     Next
     If lty11 = "定线" Then
        Form2.ListView2(a - 1).ListItems.Item(i).SubItems(17) = rs.Fields(17).Value
     End If
     If lty11 = "竣工" Or lty11 = "建筑物位置测定" Then
        Form2.ListView2(a - 1).ListItems.Item(i).SubItems(17) = rs.Fields(17).Value
        Form2.ListView2(a - 1).ListItems.Item(i).SubItems(18) = rs.Fields(18).Value
     End If
     If lty11 = "零星验字工程" Then
        Form2.ListView2(a - 1).ListItems.Item(i).SubItems(17) = rs.Fields(17).Value
     End If
      rs.MoveNext
     Next
   rs.Close
   End If
Next

  With Form2.CommonDialog2
  .Filter = "数据库文件(*.mdb)|*.mdb|" '在commondialog控件中过滤文件
  .FilterIndex = 2
  .ShowSave
  End With
  If Form2.CommonDialog2.FileName = "" Then
   MsgBox "你必须输入一个文件名，请重新保存一次！"
   Exit Sub
Else
   zfm = Form2.CommonDialog2.FileName
End If
zpstr = "Provider=Microsoft.Jet.OLEDB.4.0;"   '不能把这里的4.0改为3.51
zpstr = zpstr & "Data Source=" & zfm
zcat.Create zpstr  '创建数据库

 Dim tbl(6) As New Table
 Dim zstrTableName(6) As String
 zstrTableName(0) = "地籍"
 zstrTableName(1) = "定线"
 zstrTableName(2) = "计划内"
 zstrTableName(3) = "建筑物位置测定"
 zstrTableName(4) = "竣工"
 zstrTableName(5) = "零星验字工程"
 zstrTableName(6) = "松北"

 For i = o To 6
 zcat.ActiveConnection = zpstr
   tbl(i).Name = zstrTableName(i)   '表的名称s
          tbl(i).Columns.Append "工程编号", adVarWChar, 200     '表的第一个字段
          tbl(i).Columns.Append "建设单位", adVarWChar, 200     '表的第一个字段
          tbl(i).Columns.Append "工程名称", adVarWChar, 200   '表的第一个字段
          tbl(i).Columns.Append "工程地点", adVarWChar, 200     '表的第一个字段
          tbl(i).Columns.Append "联系人及电话", adVarWChar, 200     '表的第一个字段
          tbl(i).Columns.Append "接受日期", adDate, 200      '表的第一个字段
          tbl(i).Columns.Append "下达日期", adDate, 200      '表的第一个字段
          tbl(i).Columns.Append "应交日期", adDate, 200      '表的第一个字段
          tbl(i).Columns.Append "实交日期", adDate, 200      '表的第一个字段
          tbl(i).Columns.Append "总工办接受日期", adDate, 200      '表的第一个字段
          tbl(i).Columns.Append "出图日期", adDate, 200      '表的第一个字段
          tbl(i).Columns.Append "予收额（元）", adCurrency, 200     '表的第一个字段
          tbl(i).Columns.Append "结算额（元）", adCurrency, 200     '表的第一个字段
          tbl(i).Columns.Append "实收额（元）", adCurrency, 200     '表的第一个字段
          tbl(i).Columns.Append "完成单位", adVarWChar, 200     '表的第一个字段
          tbl(i).Columns.Append "超期工程", adVarWChar, 200     '表的第一个字段
          tbl(i).Columns.Append "备注", adVarWChar, 200     '表的第一个字段
    If zstrTableName(i) = "定线" Then
        tbl(i).Columns.Append "规划报件审批编号", adVarWChar, 200     '表的第一个字段
    End If
    If zstrTableName(i) = "建筑物位置测定" Or zstrTableName(i) = "竣工" Then
        tbl(i).Columns.Append "原件工程编号", adVarWChar, 200     '表的第一个字段
        tbl(i).Columns.Append "规划报件审批编号", adVarWChar, 200     '表的第一个字段
    End If
    If zstrTableName(i) = "零星验字工程" Then
        tbl(i).Columns.Append "原件工程编号", adVarWChar, 200     '表的第一个字段
    End If
  zcat.Tables.Append tbl(i)    '建立数据表'
 Next

  zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & "地籍", zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form2.ListView2(0).ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form2.ListView2(0).ListItems.Item(m)
        For ghz = 1 To 16
            .Fields(ghz).Value = Form2.ListView2(0).ListItems.Item(m).SubItems(ghz)
        Next
  End With
    zrs.MoveNext
  Next
  zrs.Close
  zconn.Close

   zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & "定线", zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form2.ListView2(1).ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form2.ListView2(1).ListItems.Item(m)
        For ghz = 1 To 17
            .Fields(ghz).Value = Form2.ListView2(1).ListItems.Item(m).SubItems(ghz)

        Next
  End With
    zrs.MoveNext
  Next
  zrs.Close
  zconn.Close
  
   zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & "计划内", zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form2.ListView2(2).ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form2.ListView2(2).ListItems.Item(m)
        For ghz = 1 To 16
            .Fields(ghz).Value = Form2.ListView2(2).ListItems.Item(m).SubItems(ghz)

        Next
  End With
    zrs.MoveNext
  Next
  zrs.Close
  zconn.Close

   zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & "建筑物位置测定", zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form2.ListView2(3).ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form2.ListView2(3).ListItems.Item(m)
        For ghz = 1 To 18
            .Fields(ghz).Value = Form2.ListView2(3).ListItems.Item(m).SubItems(ghz)

        Next
  End With
    zrs.MoveNext
  Next
  zrs.Close
  zconn.Close
   zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & "竣工", zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form2.ListView2(4).ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form2.ListView2(4).ListItems.Item(m)
        For ghz = 1 To 18
            .Fields(ghz).Value = Form2.ListView2(4).ListItems.Item(m).SubItems(ghz)

        Next
  End With
    zrs.MoveNext
  Next
  zrs.Close
  zconn.Close
   zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & "零星验字工程", zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form2.ListView2(5).ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form2.ListView2(5).ListItems.Item(m)
        For ghz = 1 To 17
            .Fields(ghz).Value = Form2.ListView2(5).ListItems.Item(m).SubItems(ghz)

        Next
  End With
    zrs.MoveNext
  Next
  zrs.Close
  zconn.Close
   zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & "松北", zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form2.ListView2(6).ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form2.ListView2(6).ListItems.Item(m)
        For ghz = 1 To 16
            .Fields(ghz).Value = Form2.ListView2(6).ListItems.Item(m).SubItems(ghz)

        Next
  End With
    zrs.MoveNext
  Next
  zrs.Close
  zconn.Close
  Dim ln As Long
  ln = MsgBox("数据备份完毕！", vbInformation, "提示！")

End Sub


Public Sub beifen2(username As String, MenuItem As Long)
Dim gfm As String  'gfm变量用来获取用户输入的文件名
Dim a, i, j, m As Integer
a = 0
     Form2.ListView1(0).ListItems.Clear
     Form2.ListView1(1).ListItems.Clear
     Form2.ListView1(2).ListItems.Clear
     Form2.ListView1(3).ListItems.Clear
     Form2.ListView1(4).ListItems.Clear
     Form2.ListView1(5).ListItems.Clear
     Form2.ListView1(6).ListItems.Clear
For Each mytab In gcat.Tables
  lty11 = mytab.Name
   lty12 = left(lty11, 2)
   If lty12 <> "sy" And lty12 <> "dt" And lty12 <> "my" And lty12 <> "密码" And lty12 <> "流程" Then
       a = a + 1
   grs.CursorLocation = adUseClient
   grs.Open lty11, gconn, adOpenKeyset, adLockPessimistic
    For i = 1 To grs.RecordCount
      Form2.ListView1(a - 1).ListItems.Add , , grs.Fields(0).Value
     For j = 1 To 123
      Form2.ListView1(a - 1).ListItems.Item(i).SubItems(j) = grs.Fields(j).Value
     Next
      grs.MoveNext
     Next
   grs.Close
   End If
Next

  With Form2.CommonDialog1
  .Filter = "数据库文件(*.mdb)|*.mdb|" '在commondialog控件中过滤文件
  .FilterIndex = 2
  .ShowSave
  End With
  If Form2.CommonDialog1.FileName = "" Then
   MsgBox "你必须输入一个文件名，请重新保存一次！"
   Exit Sub
Else
   zfm = Form2.CommonDialog1.FileName
End If
zpstr = "Provider=Microsoft.Jet.OLEDB.4.0;"   '不能把这里的4.0改为3.51
zpstr = zpstr & "Data Source=" & zfm
zcat.Create zpstr  '创建数据库