frmindata.frm

数据连接程序放到数据库里

         AutoSize        =   -1  'True
         Caption         =   "帐号编码"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   3570
         TabIndex        =   15
         Top             =   570
         Width           =   840
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "基金代码"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   180
         TabIndex        =   12
         Top             =   570
         Width           =   840
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "日 期"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Left            =   210
         TabIndex        =   10
         Top             =   195
         Width           =   525
      End
   End
End
Attribute VB_Name = "frmInData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim MySql As String
Dim i As Integer

Private Sub cmdbutton_Click(Index As Integer)
Dim InDate As String
Dim FCode As String
Dim FNum As String
On Error GoTo errJ
    InDate = Format(Me.DTPicker.Value, "yyyy-mm-dd")
    FCode = Trim(Me.Combo1.Text)
    FNum = Trim(Me.Combo2.Text)
    If Trim(InDate) = "" Or Trim(FCode) = "" Or Trim(FNum) = "" Then
        MsgBox ("请录入全总数据！")
        Exit Sub
    End If
    Set RsBlannce = Nothing
    Set RsBlannce = New ADODB.Recordset
    MySql = "select * from accountbalance where ffundcode = '" & FCode & "' and faccnum = '" & FNum & "' and fdate = '" & InDate & "'"
    RsBlannce.Open MySql, gcnnDataLink, adOpenStatic, adLockOptimistic
    If RsBlannce.RecordCount < 1 Then
        If Index = 0 Then
            MySql = "insert into accountbalance (fdate,ffundcode,faccnum,fbal) values ('" & InDate & "','" & FCode & "','" & FNum & "'," & Val(Me.MaskEdBox1.Text) & ")"
        Else
            MySql = ""
        End If
    Else
        If Index = 0 Then
            MySql = "update accountbalance set fdate = '" & InDate & "', ffundcode = '" & FCode & "',faccnum = '" & FNum & "',fbal = " & Val(Me.MaskEdBox1.Text) & "where ffundcode = '" & FCode & "' and faccnum = '" & FNum & "' and fdate ='" & InDate & "'"
        Else
            MySql = "delete from accountbalance where ffundcode = '" & FCode & "' and faccnum = '" & FNum & "' and fdate ='" & InDate & "'"
        End If
    End If
    gcnnDataLink.Execute MySql
    MySql = "select AccountBalance.*,AccountMessage.FAccName from accountbalance left outer join accountmessage  on accountbalance.FFundCode = accountmessage.ffundcode and accountbalance.FAccNum = accountmessage.faccnum order by accountbalance.fdate,accountbalance.ffundcode,accountbalance.faccnum"
    Call InitGrid
    Call LoadGrid
    Call Init
    Exit Sub
 
errJ:
 MsgBox "保存数据失败！原因：" & Err.Description
End Sub

Private Sub cmdClear_Click()
    Call Init
End Sub


Private Sub cmdexit_Click()
    End
End Sub
Private Sub cmdsearch_Click()
    Dim InDate As String
    Dim Wh As String
    InDate = Format(Me.DTDate.Value, "yyyy-mm-dd")
    MSFGrid.Rows = 1
    Wh = "accountbalance.FFundCode = accountmessage.ffundcode and accountbalance.FAccNum = accountmessage.faccnum where accountbalance.fdate = '" & InDate & "'"
    If Trim(comFCode.Text) <> "" Then Wh = Wh & "and accountbalance.ffundcode = '" & Trim(comFCode.Text) & "'"
    Wh = Wh & " order by accountbalance.fdate,accountbalance.ffundcode,accountbalance.faccnum"
    MySql = "select AccountBalance.*,AccountMessage.FAccName from accountbalance left outer join accountmessage on " & Wh
    Call InitGrid
    Call LoadGrid
End Sub

Private Sub Combo1_LostFocus()
    Call CombNum
End Sub

Private Sub Command1_Click()
    frmAcc.Show 1
End Sub
Private Sub Form_Load()
    DTDate.Value = Date

    MySql = "select AccountBalance.*,AccountMessage.FAccName from accountbalance left outer join accountmessage  on accountbalance.FFundCode = accountmessage.ffundcode and accountbalance.FAccNum = accountmessage.faccnum order by accountbalance.fdate,accountbalance.ffundcode,accountbalance.faccnum"
    Call LoadGrid
    Call InitComb
    Call Init
End Sub
Private Sub LoadGrid()
    On Error GoTo ErrHander
    Dim j As Integer
    j = 1
    MSFGrid.Clear
    Call InitGrid
    Set RsBlannce = Nothing
    Set RsBlannce = New ADODB.Recordset
    RsBlannce.Open MySql, gcnnDataLink, adOpenKeyset, adLockOptimistic
    With RsBlannce
        Do While Not .EOF
            Me.MSFGrid.Rows = j + 1
            Me.MSFGrid.TextMatrix(j, 1) = !Fdate
            Me.MSFGrid.TextMatrix(j, 2) = !ffundcode
            Me.MSFGrid.TextMatrix(j, 3) = !faccnum
            Me.MSFGrid.TextMatrix(j, 4) = IIf(Not IsNull(!faccname), !faccname, "")
            Me.MSFGrid.TextMatrix(j, 5) = Format(!fbal, "##########0.00")
        j = j + 1
        .MoveNext
        Loop
        .Close
    End With
    Set RsBlannce = Nothing
    Exit Sub
ErrHander:
    Debug.Print Err.Description
    Err.Number = 0
End Sub

Private Sub InitGrid()
    Dim j As Integer
    With MSFGrid
        .Cols = 6
        For i = 1 To 5
            .ColAlignment(i) = flexAlignCenterCenter
        Next
        .ColWidth(0) = 0
        .ColWidth(1) = 1500
        .ColWidth(2) = 1500
        .ColWidth(3) = 1000
        .ColWidth(4) = 2500
        .ColWidth(5) = 1500
        .TextMatrix(0, 1) = "日 期"
        .TextMatrix(0, 2) = "基金代码"
        .TextMatrix(0, 3) = "帐户编号"
        .TextMatrix(0, 4) = "帐户名称"
        .TextMatrix(0, 5) = "帐户余额"
    End With
End Sub

Private Sub InitComb()
    Dim RsCode As New ADODB.Recordset
    MySql = "select DISTINCT ffundcode from accountmessage"
    RsCode.Open MySql, gcnnDataLink, adOpenKeyset, adLockOptimistic
    Me.Combo1.Clear
    Me.comFCode.Clear
    With RsCode
        Do While Not .EOF
            Me.Combo1.AddItem (Trim(!ffundcode))
            Me.comFCode.AddItem (Trim(!ffundcode))
        .MoveNext
        Loop
        .Close
    End With
    Set RsCode = Nothing
    Call CombNum
End Sub

Private Sub CombNum()
    Dim RsNum As New ADODB.Recordset
    Me.Combo2.Clear
    If Me.Combo1.Text <> "" Then
        MySql = "select DISTINCT FAccNum from accountmessage where FFundCode = '" & Me.Combo1.Text & "'"
        RsNum.Open MySql, gcnnDataLink, adOpenStatic, adLockOptimistic
        With RsNum
            Do While Not .EOF
                Me.Combo2.AddItem (Trim(RsNum!faccnum))
            .MoveNext
            Loop
            .Close
        End With
        Set RsNum = Nothing
    End If
End Sub

Private Sub Init()
    Me.DTPicker.Value = Date
    Me.MaskEdBox1.Text = 0
    Me.Combo1.Text = ""
    Me.Combo2.Text = ""
End Sub


Private Sub MaskEdBox1_LostFocus()
    If MaskEdBox1.Text = "" Then MaskEdBox1.Text = 0
End Sub


Private Sub MSFGrid_DblClick()
    Dim i As Integer
    i = MSFGrid.Row
    With MSFGrid
        DTPicker.Value = .TextMatrix(i, 1)
        Combo1.Text = .TextMatrix(i, 2)
        Combo2.Text = .TextMatrix(i, 3)
        MaskEdBox1.Text = .TextMatrix(i, 5)
    End With
End Sub