frmdatatrim.frm

适合乡镇供电所使用电费处理系统v3 软件

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmDataSave 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "上报存档数据生成"
   ClientHeight    =   1575
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7530
   Icon            =   "frmDataTrim.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1575
   ScaleWidth      =   7530
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frame1 
      Height          =   1575
      Left            =   15
      TabIndex        =   0
      Top             =   -15
      Width           =   7515
      Begin VB.CommandButton Command1 
         Caption         =   "开始生成(&S)"
         Height          =   390
         Left            =   4350
         TabIndex        =   6
         Top             =   1080
         Width           =   1290
      End
      Begin VB.CommandButton Command4 
         Caption         =   "退出(&E)"
         Height          =   390
         Left            =   6060
         TabIndex        =   5
         Top             =   1110
         Width           =   1275
      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         Left            =   1500
         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   300
         Width           =   2010
      End
      Begin VB.OptionButton Option1 
         Caption         =   "全部用户"
         Height          =   255
         Left            =   3840
         TabIndex        =   2
         Top             =   330
         Width           =   1035
      End
      Begin VB.OptionButton Option2 
         Caption         =   "只生成产生电费用户"
         Height          =   240
         Left            =   5160
         TabIndex        =   1
         Top             =   345
         Width           =   1935
      End
      Begin MSComctlLib.ProgressBar PsBar1 
         Height          =   285
         Left            =   105
         TabIndex        =   4
         Top             =   765
         Width           =   7350
         _ExtentX        =   12965
         _ExtentY        =   503
         _Version        =   393216
         Appearance      =   0
      End
      Begin VB.Label Label2 
         Caption         =   "注：本系统生成的文件存放在C:\My Documents"
         Height          =   240
         Left            =   135
         TabIndex        =   8
         Top             =   1215
         Width           =   4020
      End
      Begin VB.Label Label1 
         Caption         =   "输出文件格式:"
         Height          =   195
         Left            =   165
         TabIndex        =   7
         Top             =   360
         Width           =   1260
      End
   End
End
Attribute VB_Name = "frmDataSave"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim FileFormat As Integer
Dim FileTxt As String, FileExcel As String, FileHtml As String
Dim TempR As Recordset
Dim Star_stop As Boolean

Private Sub Command1_Click()
  Dim i As Long
  If Command1.Caption = "开始生成(&S)" Then
     Command1.Caption = "停止生成(&T)"
     Screen.MousePointer = 11
     PsBar1.Visible = True
     Set MdbR = NdMd.OpenRecordset("SELECT * FROM 村档案")
     If MdbR.RecordCount <> 0 Then
        MdbR.MoveLast
        MdbR.MoveFirst
        PsBar1.Min = 0
        PsBar1.Max = MdbR.RecordCount
        For i = 0 To MdbR.RecordCount - 1
            DoEvents
            If Star_stop Then
               Star_stop = False
               Exit For
            End If
            FileHtml = Trim(MdbR.Fields(3)) & "(" & Year(Date) & "年" & Format(Month(Date), "0#") & "月份" & ").Html"
            Call OutHtml(MdbR.Fields(2))
            PsBar1.Value = i
            MdbR.MoveNext
        Next
     End If
     PsBar1.Value = 0
     PsBar1.Visible = False
     Screen.MousePointer = 0
'     If Star_stop = False Then
 '       MsgBox "数据生成完毕！", vbInformation
 '    End If
 Else
     Command1.Caption = "开始生成(&S)"
     Star_stop = True
     PsBar1.Visible = False
     PsBar1.Value = 0
 End If
End Sub

Private Sub Command4_Click()
  Unload Me
End Sub

Private Sub Form_Load()
   DoEvents
   Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
   OpenMdb
   On Error Resume Next
   FileFormat = GetSetting(App.EXEName, "PrintSetup", "Filemat", "")
   FileTxt = Trim(XcName) & "(" & Year(Date) & "年" & Format(Month(Date), "0#") & "月份" & ").Doc"
   FileExcel = Trim(XcName) & "(" & Year(Date) & "年" & Format(Month(Date), "0#") & "月份" & ").xls"
   Combo1.AddItem "Text文本文件"
   Combo1.AddItem "Excel电子表格"
   Combo1.AddItem "Html文件"
   Combo1.ListIndex = IIf(FileFormat = 0, 0, FileFormat)
   If Len(UserSeek) = 0 Then
      GzYue = Format(Month(Date), "0#")
      Call sTruInfo
   End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
  On Error Resume Next
  SaveSetting App.EXEName, "PrintSetup", "Filemat", Combo1.ListIndex
  NdMd.Close
End Sub

Sub OutFile()
    Screen.MousePointer = 11
    Select Case Combo1.ListIndex
           Case 0  'text
                If FileExists("C:\My Documents\" & FileTxt) Then
                   If MsgBox(FileTxt & "文件已存在，是否覆盖？(Y/N)", vbYesNo + 32) = vbYes Then
                      Kill "C:\My Documents\" & FileTxt
                      Call OutText
                   Else
                      Screen.MousePointer = 0
                      Exit Sub
                   End If
                Else
                   Call OutText
                End If
           Case 1  'excel
                If FileExists("C:\My Documents\" & FileExcel) Then
                   If MsgBox(FileExcel & "文件已存在，是否覆盖？(Y/N)", vbYesNo + 32) = vbYes Then
                      Kill "C:\My Documents\" & FileExcel
                      Call OutExcel
                   Else
                      Screen.MousePointer = 0
                      Exit Sub
                   End If
                Else
                   Call OutExcel
                End If
           Case 2  'html
                If FileExists("C:\My Documents\" & FileHtml) Then
                   If MsgBox(FileHtml & "文件已存在，是否覆盖？(Y/N)", vbYesNo + 32) = vbYes Then
                      Kill "C:\My Documents\" & FileHtml
                      Call OutHtml("002333")
                   Else
                      Screen.MousePointer = 0
                      Exit Sub
                   End If
                 Else
                   Call OutHtml("0030003")
                End If
    End Select
    MsgBox "文件成功生成！", vbInformation
    Screen.MousePointer = 0
'    Exit Sub

End Sub

Sub OutText()
    On Error GoTo IsamErr
    NdMd.Execute "SELECT 用户电费.抄表码," _
    & "用户电费.全称,用户电费.[" & AAA & "] AS 上期示数, 用户电费.[" & AA & "] AS 本期示数," _
    & "用户电费.倍率,用户电费.[" & BB & "] AS 调整电量,用户电费.[" & CC & "] AS 本次电量, 用户电费.[" & DD & "] AS 合计电量, " _
    & "用户电费.电价,用户电费.[" & EE & "] AS 调整金额, 用户电费.[" & FF & "] AS 滞纳金, 用户电费.[" & GG & "] AS 本次电费, 用户电费.[" & HH & "] AS 合计电费," _
    & "用户电费.台区 INTO INTO [Text;DATABASE=C:\My Documents\].[" & FileTxt & "]" _
    & "FROM 用户电费 where 用户电费.镇村代码='" & UserSeek & "' and 用户电费.[" & AA & "] <>'' order by 用户电费.组合编码 asc"
   Exit Sub

IsamErr:
       If Err.Number = 3170 Then
          MsgBox "软件驱动ISAM未安装或文件破坏！", vbInformation
          Star_stop = True
          Exit Sub
       Else
          MsgBox Err.Description, vbCritical
          Exit Sub
       End If
End Sub

Sub OutExcel()
    On Error GoTo IsamErr
    NdMd.Execute "SELECT 用户电费.抄表码," _
    & "用户电费.全称,用户电费.[" & AAA & "] AS 上期示数, 用户电费.[" & AA & "] AS 本期示数," _
    & "用户电费.倍率,用户电费.[" & BB & "] AS 调整电量,用户电费.[" & CC & "] AS 本次电量, 用户电费.[" & DD & "] AS 合计电量, " _
    & "用户电费.电价,用户电费.[" & EE & "] AS 调整金额, 用户电费.[" & GG & "] AS 本次电费, " _
    & "用户电费.[" & HH & "] AS 合计电费 INTO [Excel 8.0;DATABASE=C:\My Documents\" & FileExcel & "].[用户电费]" _
    & "FROM 用户电费 where 用户电费.镇村代码='" & UserSeek & "' and 用户电费.[" & AA & "] <>''order by 用户电费.组合编码 asc"
   Exit Sub

IsamErr:
       If Err.Number = 3170 Then
          MsgBox "软件驱动ISAM未安装或文件破坏！", vbInformation
          Star_stop = True
          Exit Sub
       Else
          MsgBox Err.Description, vbCritical
          Star_stop = True
          Exit Sub
       End If

End Sub

Sub OutHtml(ZcStr As String)
    On Error GoTo IsamErr
    If FileExists("C:\My Documents\" & FileHtml) Then
       Kill "C:\My Documents\" & FileHtml
    End If
    If Option1 Then
       NdMd.Execute "SELECT 用户电费.用户编码 as 编码," _
       & "用户电费.用户名称 as 名称,用户电费.[" & AAA & "] AS 上月, 用户电费.[" & AA & "] AS 本月," _
       & "用户电费.倍率,用户电费.[" & BB & "] AS 加减电量,用户电费.[" & CC & "] AS 本次电量, 用户电费.[" & DD & "] AS 计费电量, " _
       & "用户电费.电价,用户电费.[" & EE & "] AS 调整金额, 用户电费.[" & FF & "] AS 滞纳金, 用户电费.[" & GG & "] AS 本次电费, 用户电费.[" & HH & "] AS 合计电费 INTO [HTML Export;DATABASE=C:\My Documents\].[" & FileHtml & "]" _
       & "FROM 用户电费 where 用户电费.镇村代码='" & ZcStr & "' order by 用户电费.抄表码 asc"
    Else
       Set TempR = NdMd.OpenRecordset("SELECT * FROM 用户电费 where 用户电费.镇村代码='" & ZcStr & "'and 用户电费.[" & AA & "] <>'' order by 用户电费.抄表码 asc")
       If TempR.RecordCount <> 0 Then
            NdMd.Execute "SELECT 用户电费.用户编码 as 编码," _
            & "用户电费.用户名称 as 名称,用户电费.[" & AAA & "] AS 上月, 用户电费.[" & AA & "] AS 本月," _
            & "用户电费.倍率,用户电费.[" & BB & "] AS 加减电量,用户电费.[" & CC & "] AS 本次电量, 用户电费.[" & DD & "] AS 计费电量, " _
            & "用户电费.电价,用户电费.[" & EE & "] AS 调整金额, 用户电费.[" & FF & "] AS 滞纳金, 用户电费.[" & GG & "] AS 本次电费, 用户电费.[" & HH & "] AS 合计电费 INTO [HTML Export;DATABASE=C:\My Documents\].[" & FileHtml & "]" _
            & "FROM 用户电费 where 用户电费.镇村代码='" & ZcStr & "'and 用户电费.[" & AA & "] <>'' order by 用户电费.抄表码 asc"
       End If
    End If
    
    Exit Sub

IsamErr:
       If Err.Number = 3170 Then
          MsgBox "软件驱动ISAM未安装或文件破坏！", vbInformation
          Star_stop = True
          Exit Sub
       Else
          MsgBox Err.Description, vbCritical
          Star_stop = True
          Exit Sub
       End If
End Sub