m4.bas

办公自动化 vb+server2

  ln = MsgBox("数据备份完毕！", vbInformation, "提示！")
End Sub
Public Sub beifen3(username As String, MenuItem As Long)
Dim gfm As String  'gfm变量用来获取用户输入的文件名
Dim a, i, j, m As Integer
a = 0
     Form2.ListView3(0).ListItems.Clear

   gzrs.CursorLocation = adUseClient
   gzrs.Open "出图", gzconn, adOpenKeyset, adLockPessimistic
    For i = 1 To gzrs.RecordCount
      Form2.ListView3(0).ListItems.Add , , gzrs.Fields(0).Value
     For j = 1 To 19
      Form2.ListView3(0).ListItems.Item(i).SubItems(j) = gzrs.Fields(j).Value
     Next
      gzrs.MoveNext
     Next
   gzrs.Close



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

 Dim tbl As New Table
 Dim zstrTableName As String
 zcat.ActiveConnection = zpstr
 zstrTableName = "出图"
   tbl.Name = zstrTableName   '表的名称s
          tbl.Columns.Append "购图编号", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "购图单位", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "经办人及电话", adVarWChar, 200   '表的第一个字段
          tbl.Columns.Append "比例尺", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "图号", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "地区类别", adVarWChar, 200      '表的第一个字段
          tbl.Columns.Append "全额", adCurrency, 200      '表的第一个字段
          tbl.Columns.Append "购图用途", adVarWChar, 200      '表的第一个字段
          tbl.Columns.Append "购图日期", adDate, 200      '表的第一个字段
          tbl.Columns.Append "经办人", adVarWChar, 200      '表的第一个字段
          tbl.Columns.Append "经办人备注", adVarWChar, 200      '表的第一个字段
          tbl.Columns.Append "审核人", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "审核人备注", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "财务部", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "财务部实收额", adCurrency, 200     '表的第一个字段
          tbl.Columns.Append "财务部备注", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "出图部门", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "出图部门备注", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "档案部", adVarWChar, 200     '表的第一个字段
          tbl.Columns.Append "档案部备注", adVarWChar, 200     '表的第一个字段
  zcat.Tables.Append tbl   '建立数据表'

  zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & "出图", zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form2.ListView3(0).ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form2.ListView3(0).ListItems.Item(m)
        For ghz = 1 To 19
            .Fields(ghz).Value = Form2.ListView3(0).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 beifen4(username As String, MenuItem As Long)
Dim gfm As String  'gfm变量用来获取用户输入的文件名
Dim a, i, j, m As Integer
a = 0
     Form2.ListView4(0).ListItems.Clear
     Form2.ListView4(1).ListItems.Clear
   hzrs.CursorLocation = adUseClient
   hzrs.Open "勘察工程任务结算单", hzconn, adOpenKeyset, adLockPessimistic
    For i = 1 To hzrs.RecordCount
      Form2.ListView4(0).ListItems.Add , , hzrs.Fields(0).Value
     For j = 1 To 50
      Form2.ListView4(0).ListItems.Item(i).SubItems(j) = hzrs.Fields(j).Value
     Next
      hzrs.MoveNext
     Next
   hzrs.Close
   
   hzrs.CursorLocation = adUseClient
   hzrs.Open "经营人员结算单", hzconn, adOpenKeyset, adLockPessimistic
    For i = 1 To hzrs.RecordCount
      Form2.ListView4(1).ListItems.Add , , hzrs.Fields(0).Value
     For j = 1 To 12
      Form2.ListView4(1).ListItems.Item(i).SubItems(j) = hzrs.Fields(j).Value
     Next
      hzrs.MoveNext
     Next
   hzrs.Close


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

 Dim tbl As New Table
 Dim zstrTableName As String
 zcat.ActiveConnection = zpstr
 zstrTableName = "勘察工程任务结算单"
   tbl.Name = zstrTableName   '表的名称s
   tbl.Columns.Append "ID", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "工程编号", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "工程名称", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "总进尺", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "钻探进尺", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "静力触探进尺", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "合同额", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "结算工作量1", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "结算总价1", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "结算备注1", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "结算工作量2", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "结算总价2", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "结算备注2", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "结算类别3", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "结算孔深3", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "结算单位3", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "结算工作量3", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "结算总价3", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "结算备注3", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "结算类别4", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "结算孔深4", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "结算单位4", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "结算工作量4", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "结算总价4", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "结算备注4", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "合计", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "下拨工作量1", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "下拨小计1", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "下拨工作量11", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "下拨小计11", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "下拨合计1", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "下拨工作量2", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "下拨小计2", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "下拨工作量21", adVarWChar, 200     '表的第一个字段
   tbl.Columns.Append "下拨小计21", adVarWChar, 200    '表的第一个字段
   tbl.Columns.Append "下拨合计2", adVarWChar, 200   '表的第一个字段
   tbl.Columns.Append "下拨工作量3", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "下拨小计3", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "下拨工作量31", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "下拨小计31", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "下拨合计3", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "下拨其它4", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "结算员", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "结算员备注", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "勘察经营部长", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "勘察经营部长备注", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "主管院长", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "主管院长备注", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "财务部", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "财务部备注", adVarWChar, 200  '表的第一个字段
   tbl.Columns.Append "结算日期", adVarWChar, 200  '表的第一个字段
     
  zcat.Tables.Append tbl   '建立数据表'
  
 Dim tbl1 As New Table
 Dim zstrTableName1 As String
 zcat.ActiveConnection = zpstr
 zstrTableName1 = "经营人员结算单"
   tbl1.Name = zstrTableName1   '表的名称s
   tbl1.Columns.Append "ID", adVarWChar, 200     '表的第一个字段
   tbl1.Columns.Append "姓名", adVarWChar, 200     '表的第一个字段
   tbl1.Columns.Append "工程编号", adVarWChar, 200    '表的第一个字段
   tbl1.Columns.Append "工程名称", adVarWChar, 200   '表的第一个字段
   tbl1.Columns.Append "建设单位", adVarWChar, 200  '表的第一个字段
   tbl1.Columns.Append "合同额", adVarWChar, 200     '表的第一个字段
   tbl1.Columns.Append "进款额", adVarWChar, 200    '表的第一个字段
   tbl1.Columns.Append "结算系数", adVarWChar, 200   '表的第一个字段
   tbl1.Columns.Append "结算额", adVarWChar, 200  '表的第一个字段
   tbl1.Columns.Append "欠款", adVarWChar, 200     '表的第一个字段
   tbl1.Columns.Append "结算员", adVarWChar, 200    '表的第一个字段
   tbl1.Columns.Append "结算日期", adVarWChar, 200   '表的第一个字段
   tbl1.Columns.Append "备注", adVarWChar, 200  '表的第一个字段
  zcat.Tables.Append tbl1   '建立数据表'
  zconn.Open zpstr
  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & "勘察工程任务结算单", zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form2.ListView4(0).ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form2.ListView4(0).ListItems.Item(m)
        For ghz = 1 To 50
            .Fields(ghz).Value = Form2.ListView4(0).ListItems.Item(m).SubItems(ghz)
        Next
  End With
    zrs.MoveNext
  Next
  zrs.Close

  zrs.CursorLocation = adUseClient
  zrs.Open "select * from " & "经营人员结算单", zconn, adOpenKeyset, adLockPessimistic
 For m = 1 To Form2.ListView4(1).ListItems.Count
   With zrs
        .AddNew
        .Fields(0).Value = Form2.ListView4(1).ListItems.Item(m)
        For ghz = 1 To 12
            .Fields(ghz).Value = Form2.ListView4(1).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 linshi1(username As String, MenuItem As Long)
For Each mytab In gcat.Tables
        a = a + 1
  lty11 = mytab.Name
   lty12 = left(lty11, 2)
   If lty12 <> "sy" And lty12 <> "dt" And lty12 <> "my" And lty12 <> "密码" And lty12 <> "流程" Then
   grs.CursorLocation = adUseClient
   grs.Open lty11, gconn, adOpenKeyset, adLockPessimistic
  For n = 1 To grs.RecordCount
   If grs.Fields(114).Value = "0" And grs.Fields(116).Value <> "0" Then
    grs.Fields(114).Value = "张琼"
    grs.Fields(115).Value = "出差,权限转移"
   End If
    grs.MoveNext
   Next
   grs.Close
   End If
 Next
  Dim ln As Long
  ln = MsgBox("临时程序运行完毕！", vbInformation, "提示！")

End Sub