form1.frm

多种数据库或数据文件转化成工行网上银行文件格式

'End If

Txt_usage = Combo4.Text

SQLyear = Format(Combo1.Text, "0000")
SQLmouth = Format(Combo2.Text, "00")
Txt_bankupNULL = True

Select Case ServerKind
Case 0, 1, 2
DbCon = OpenCn(Text8.Text, ServerKind, Text9.Text, Text10.Text, Text11.Text)
oRs.CursorLocation = adUseClient
If Text16.Text = "" Then

SQLString = "select [" & Text13 & "],[" & Text14 & "],[" & Text15 & "] From " & Text18 & " where [" & Text17 & "]='" & SQLyear & SQLmouth & "'"
Txt_bankupNULL = True
Else
SQLString = "select [" & Text13 & "],[" & Text14 & "],[" & Text15 & "],[" & Text16 & "] From " & Text18 & " where [" & Text17 & "]='" & SQLyear & SQLmouth & "'"
Txt_bankupNULL = False
End If

oRs.Open SQLString, cnNew, adOpenKeyset, adLockOptimistic

Case 3
DbCon = OpenCn(Label24.Caption, ServerKind, Text9.Text, Text10.Text, Text11.Text)
oRs.CursorLocation = adUseClient
If Text16.Text = "" Then

SQLString = "select [" & Text13 & "],[" & Text14 & "],[" & Text15 & "] From " & Text18 & " where [" & Text17 & "]='" & SQLyear & SQLmouth & "'"
Txt_bankupNULL = True
Else
SQLString = "select [" & Text13 & "],[" & Text14 & "],[" & Text15 & "],[" & Text16 & "] From " & Text18 & " where [" & Text17 & "]='" & SQLyear & SQLmouth & "'"
Txt_bankupNULL = False
End If
oRs.Open SQLString, cnNew, adOpenKeyset, adLockOptimistic

Case 4
DbCon = OpenCn(Label24.Caption, ServerKind, Text9.Text, Text10.Text, Text11.Text)
oRs.CursorLocation = adUseClient
ExcelTable = Combo5.Text
If Right(ExcelTable, 1) = "$" Then
Else
ExcelTable = ExcelTable & "$"
End If

SQLString = "select * From [" & ExcelTable & "]"
oRs.Open SQLString, cnNew, adOpenKeyset, adLockOptimistic
Txt_bankupNULL = False
End Select


oRs.MoveLast
oRs_count = oRs.RecordCount
oRs.MoveFirst
ccpb.Min = 1
ccpb.Max = oRs.RecordCount

IntI = 1
File_count = 1
IntJ = 1
Do Until oRs.EOF = True

 If IntI < 2001 Then   '检查数据表中的字段类型

 DoEvents
            If oRs.Fields(1) = OrAccount Then GoTo ORACCOUNT_NEXT
            If IsNull(oRs.Fields(2)) = True Then Txt_money = 0 Else Txt_money = CLng(oRs.Fields(2) * 100)
            If Txt_money = 0 Then GoTo ORACCOUNT_NEXT
            If Txt_bankupNULL = True Then
                    Txt_bankup = ""
            Else
                    If IsNull(oRs.Fields(3)) = True Then Txt_bankup = "" Else Txt_bankup = oRs.Fields(3)
            End If
            If IsNull(oRs.Fields(0)) = True Or IsNull(oRs.Fields(1)) = True Or oRs.Fields(0) = "" Or oRs.Fields(1) = "" Then
                    MsgBox IntJ + 1 & "行处存在非法数据，请检查数据完整性"
                    Exit Sub
            End If
            
End If
                
                Txt_Tmoney = Txt_Tmoney + Txt_money
                Txt_String = Txt_String & "RMB|" & Txt_Date & "|2|" & IntI & "|" & IntI & "||" & Txt_FBankName & "|" & _
                             Txt_Fcount & "|" & Txt_Fname & "|" & Txt_SBankName & "|" & Txt_SBprovice & "|" & Txt_SBcity & "|" & Txt_SBbranchID & "|" & _
                             oRs.Fields(1) & "|" & oRs.Fields(0) & "|" & Txt_money & "|" & Txt_usage & "|" & Txt_bankup & "|" & vbCrLf
                'Debug.Print Txt_String
                 IntI = IntI + 1
ORACCOUNT_NEXT:  Txt_money = 0
                 oRs.MoveNext
                If IntJ = oRs.RecordCount Then GoTo END_TXT
                IntJ = IntJ + 1

                
                
Else
 
END_TXT: Set FsoFile = CreateObject("Scripting.FileSystemObject")

FsoFilePath = App.Path & "\Gz" & Txt_FileDate & "-" & File_count & ".bxt"
 Set FsoStream = FsoFile.CreateTextFile(FsoFilePath, True)
            FsoStream.WriteLine ("#总计信息")
            FsoStream.WriteLine ("#注意：本文件中的金额均以分为单位！")
            FsoStream.WriteLine ("#币种|日期|总计标志|总金额|总笔数|")
            FsoStream.WriteLine ("RMB|" & Txt_Date & "|1|" & Txt_Tmoney & "|" & IntI - 1 & "|")
            FsoStream.WriteLine ("#明细指令信息")
            FsoStream.WriteLine ("#币种|日期|明细标志|顺序号|报销号|单据张数|付款帐号开户行|付款帐号|付款帐号名称|收款帐号开户行|收款帐号省份|收款帐号地市|收款帐号地区码|收款帐号|收款帐号名称|金额|汇款用途|备注信息|")
            FsoStream.WriteLine (Txt_String & "*")
            FsoStream.Close
            

            
 FsoFilePath = App.Path & "\工作回执" & Txt_FileDate & ".txt"
 If File_count = 1 Then
     Set FsoStream = FsoFile.CreateTextFile(FsoFilePath, True)
 FsoStream.WriteLine ("###########################################################################")
 FsoStream.WriteLine ("#请记录或打印以下信息，这些信息将在数据网上银行提交过程中,作为核对信息填写#")
 FsoStream.WriteLine ("###########################################################################")
  FsoStream.WriteLine ("")
  FsoStream.WriteLine ("文件标号" & vbTab & "提交文件名称" & vbTab & vbTab & "笔数" & vbTab & "金额(单位：元)")
 FsoStream.WriteLine (File_count & vbTab & vbTab & "Gz" & Txt_FileDate & "-" & File_count & ".txt" & vbTab & IntI - 1 & vbTab & Txt_Tmoney / 100)

Else
Set FsoStream = FsoFile.OpenTextFile(FsoFilePath, ForAppending)
 FsoStream.WriteLine (File_count & vbTab & vbTab & "Gz" & Txt_FileDate & "-" & File_count & ".txt" & vbTab & IntI - 1 & vbTab & Txt_Tmoney)
  End If
  FsoStream.Close
              IntI = 1
             Txt_Tmoney = 0
            File_count = File_count + 1
            Txt_String = ""
End If
ccpb.Value = IntJ
Loop

 Clocn
ShellExecute Me.hWnd, "open", App.Path & "\工作回执" & Txt_FileDate & ".txt", "", "", 4
Exit Sub
Err_deal: MsgBox Err.Description, vbCritical, "提示错误"
End Sub



Private Sub Command2_Click()
ShellExecute Me.hWnd, "open", App.Path, "", "", 4
End Sub

Private Sub Command3_Click()
ShellExecute Me.hWnd, "open", App.Path & "\setting.ini", "", "", 4
End Sub

Private Sub Command4_Click()
On Error GoTo Err_1
Dim Exist_sheet As Boolean
Dim cnExcel As New ADODB.Connection
Dim rstSchema     As ADODB.Recordset
Dim tmp As String

Label24.Caption = ""
Combo5.Clear
If ServerKind = 3 Then
    CDL1.Filter = "Access(*.mdb)|*.mdb"
    CDL1.ShowOpen
    Label24.Caption = CDL1.FileName
    If Label24.Caption = "" Then
        MsgBox "没有选择文件", vbCritical, "提示"
        Exit Sub
    End If
    cnExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Label24.Caption & ";" & _
    "User Id=admin;" & _
    "Password=;"
ElseIf ServerKind = 4 Then


    CDL1.Filter = "EXCEL(*.xls)|*.xls"
    CDL1.ShowOpen
    Label24.Caption = CDL1.FileName
    If Label24.Caption = "" Then
        MsgBox "没有选择文件", vbCritical, "提示"
        Exit Sub
    End If
    cnExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & Label24.Caption & ";" & _
    "Extended Properties=""Excel 8.0;"""
End If
 Set rstSchema = cnExcel.OpenSchema(adSchemaTables)
     Do Until rstSchema.EOF
     tmp = Right(rstSchema!TABLE_NAME, 1)
     If tmp = "$" Then
     tmp = Left$(rstSchema!TABLE_NAME, Len(rstSchema!TABLE_NAME) - 1)
     Else
     tmp = rstSchema!TABLE_NAME
     End If

     
Combo5.AddItem tmp
 rstSchema.MoveNext
  Loop
  rstSchema.Close
  Set rstSchema = Nothing
  
cnExcel.Close
Set cnExcel = Nothing
Combo5.Text = Combo5.List(0)
Exit Sub
Err_1: MsgBox Err.Description, vbCritical, "提示"
End Sub

Private Sub Command5_Click()
Unload Me

End Sub



Private Sub Form_Load()
Text1.Text = Trim$(GetINI("设置项目", "付款单位名称", App.Path & "\setting.ini"))
Text2.Text = Trim$(GetINI("设置项目", "付款帐号", App.Path & "\setting.ini"))
Text3.Text = Trim$(GetINI("设置项目", "付款行名", App.Path & "\setting.ini"))
Text4.Text = Trim$(GetINI("设置项目", "收款行名", App.Path & "\setting.ini"))
Text5.Text = Trim$(GetINI("设置项目", "收款行号", App.Path & "\setting.ini"))
Text6.Text = Trim$(GetINI("设置项目", "省份", App.Path & "\setting.ini"))
Text7.Text = Trim$(GetINI("设置项目", "城市", App.Path & "\setting.ini"))
Text8.Text = Trim$(GetINI("设置项目", "服务器名", App.Path & "\setting.ini"))
Text9.Text = Trim$(GetINI("设置项目", "数据库名称", App.Path & "\setting.ini"))
Text10.Text = Trim$(GetINI("设置项目", "用户名", App.Path & "\setting.ini"))
Text11.Text = Trim$(GetINI("设置项目", "密码", App.Path & "\setting.ini"))
Text12.Text = Trim$(GetINI("设置项目", "排除标志", App.Path & "\setting.ini"))
Text13.Text = Trim$(GetINI("SQL", "SQLNAME", App.Path & "\setting.ini"))
Text14.Text = Trim$(GetINI("SQL", "SQLACCOUNT", App.Path & "\setting.ini"))
Text15.Text = Trim$(GetINI("SQL", "SQLMONEY", App.Path & "\setting.ini"))
Text16.Text = Trim$(GetINI("SQL", "SQLPIM", App.Path & "\setting.ini"))
Text17.Text = Trim$(GetINI("SQL", "SQLWHERE", App.Path & "\setting.ini"))
Text18.Text = Trim$(GetINI("SQL", "SQLTABLE", App.Path & "\setting.ini"))
Text19.Text = Trim$(GetINI("EXCEL", "NAME", App.Path & "\setting.ini"))
Text20.Text = Trim$(GetINI("EXCEL", "ACCOUNT", App.Path & "\setting.ini"))
Text21.Text = Trim$(GetINI("EXCEL", "MONEY", App.Path & "\setting.ini"))
Text22.Text = Trim$(GetINI("EXCEL", "BACKUP", App.Path & "\setting.ini"))
Check2.Value = CInt(Trim$(GetINI("EXCEL", "TITLE", App.Path & "\setting.ini")))
Check1.Value = CInt(Trim$(GetINI("设置项目", "AUTO", App.Path & "\setting.ini")))



OrAccount = Text12.Text
Combo1.Text = Trim$(GetINI("SQL", "SQLYEAR", App.Path & "\setting.ini"))
Combo2.Text = Trim$(GetINI("SQL", "SQLMOUTH", App.Path & "\setting.ini"))

Combo3.Text = Trim$(GetINI("设置项目", "服务器类型", App.Path & "\setting.ini"))
Combo4.Text = Trim$(GetINI("设置项目", "支付用途", App.Path & "\setting.ini"))

If Combo3.Text = "MSSQLSERVER" Then
ServerKind = 0
Label26.Text = Trim$(GetINI("说明", "MSSQLSERVER", App.Path & "\setting.ini"))
ElseIf Combo3.Text = "New ORACLE" Then
ServerKind = 1
Label26.Text = Trim$(GetINI("说明", "ORACLE", App.Path & "\setting.ini"))
ElseIf Combo3.Text = "OLD ORACLE" Then
Label26.Text = Trim$(GetINI("说明", "ORACLE", App.Path & "\setting.ini"))
ServerKind = 2

ElseIf Combo3.Text = "ACCESS" Then
ServerKind = 3
Label26.Text = Trim$(GetINI("说明", "ACCESS", App.Path & "\setting.ini"))
ElseIf Combo3.Text = "EXCEL" Then
Label26.Text = Trim$(GetINI("说明", "EXCEL", App.Path & "\setting.ini"))
 ServerKind = 4
 End If


End Sub



Private Sub Text1_LostFocus()
i = WritePrivateProfileString("设置项目", "付款单位名称", Text1.Text, App.Path & "\setting.ini")
End Sub







Private Sub Text2_LostFocus()
i = WritePrivateProfileString("设置项目", "付款帐号", Text2.Text, App.Path & "\setting.ini")
End Sub

Private Sub Text3_LostFocus()
i = WritePrivateProfileString("设置项目", "付款行名", Text3.Text, App.Path & "\setting.ini")
End Sub

Private Sub Text4_LostFocus()
i = WritePrivateProfileString("设置项目", "收款行名", Text4.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text5_LostFocus()
i = WritePrivateProfileString("设置项目", "收款行号", Text5.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text6_LostFocus()
i = WritePrivateProfileString("设置项目", "省份", Text6.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text7_LostFocus()
i = WritePrivateProfileString("设置项目", "城市", Text7.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text8_LostFocus()
i = WritePrivateProfileString("设置项目", "服务器名", Text8.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text9_LostFocus()
i = WritePrivateProfileString("设置项目", "数据库名称", Text9.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text10_LostFocus()
i = WritePrivateProfileString("设置项目", "用户名", Text10.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text11_LostFocus()
i = WritePrivateProfileString("设置项目", "密码", Text11.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text12_LostFocus()
i = WritePrivateProfileString("设置项目", "排除标志", Text12.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text13_LostFocus()
i = WritePrivateProfileString("SQL", "SQLNAME", Text13.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text14_LostFocus()
i = WritePrivateProfileString("SQL", "SQLACCOUNT", Text14.Text, App.Path & "\setting.ini")
End Sub

Private Sub Text15_LostFocus()
i = WritePrivateProfileString("SQL", "SQLMONEY", Text15.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text16_LostFocus()
i = WritePrivateProfileString("SQL", "SQLPIM", Text16.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text17_LostFocus()
i = WritePrivateProfileString("SQL", "SQLWHERE", Text17.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text18_LostFocus()
i = WritePrivateProfileString("SQL", "SQLTABLE", Text18.Text, App.Path & "\setting.ini")
End Sub

Private Sub Text19_LostFocus()
i = WritePrivateProfileString("EXCEL", "NAME", Text19.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text20_LostFocus()
i = WritePrivateProfileString("EXCEL", "ACCOUNT", Text20.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text21_LostFocus()
i = WritePrivateProfileString("EXCEL", "MONEY", Text21.Text, App.Path & "\setting.ini")
End Sub
Private Sub Text22_LostFocus()
i = WritePrivateProfileString("EXCEL", "BACKUP", Text22.Text, App.Path & "\setting.ini")
End Sub




Private Sub Check2_LostFocus()
On Error Resume Next
i = WritePrivateProfileString("EXCEL", "TITLE", CStr(Check2.Value), App.Path & "\setting.ini")

End Sub

Private Sub Check1_LostFocus()
On Error Resume Next

i = WritePrivateProfileString("设置项目", "AUTO", CStr(Check1.Value), App.Path & "\setting.ini")

End Sub






Private Sub Combo3_LostFocus()
i = WritePrivateProfileString("设置项目", "服务器类型", Combo3.Text, App.Path & "\setting.ini")

If Combo3.Text = "MSSQLSERVER" Then
ServerKind = 0
Label26.Text = Trim$(GetINI("说明", "MSSQLSERVER", App.Path & "\setting.ini"))
ElseIf Combo3.Text = "New ORACLE" Then
ServerKind = 1
Label26.Text = Trim$(GetINI("说明", "ORACLE", App.Path & "\setting.ini"))
ElseIf Combo3.Text = "OLD ORACLE" Then
Label26.Text = Trim$(GetINI("说明", "ORACLE", App.Path & "\setting.ini"))
ServerKind = 2

ElseIf Combo3.Text = "ACCESS" Then
ServerKind = 3
Label26.Text = Trim$(GetINI("说明", "ACCESS", App.Path & "\setting.ini"))
ElseIf Combo3.Text = "EXCEL" Then
Label26.Text = Trim$(GetINI("说明", "EXCEL", App.Path & "\setting.ini"))
 ServerKind = 4
 End If

End Sub

Private Sub Combo4_LostFocus()
i = WritePrivateProfileString("设置项目", "支付用途", Combo4.Text, App.Path & "\setting.ini")

End Sub

Private Sub Combo1_LostFocus()
i = WritePrivateProfileString("SQL", "SQLYEAR", Combo1.Text, App.Path & "\setting.ini")

End Sub
Private Sub Combo2_LostFocus()
i = WritePrivateProfileString("SQL", "SQLMOUTH", Combo2.Text, App.Path & "\setting.ini")

End Sub