转：金碟7.0取数代码

1
Sub di金蝶7()
    '导入金蝶7.0原始数据
    '必须添加对ADO的引用。
    '本例中引用的是"Microsfot ActiveX Data Objects 2.6 Library"
    delsheet
    Dim x, n As Integer  'x用于保存行号，n用于保存凭证表编号
    Dim stname As String  '用于保存新增凭证表的名称
    x = 2
    n = 1
    '显示提示窗口
    MsgBox "您正准备导入金蝶7.0的原始数据，请定位到数据库所在的文件夹！" _
    & vbCrLf & vbCrLf & "金蝶7.0的数据库文件在安装目录下，金蝶7.0不支持备份导入。", vbInformation, "提示信息！"

    Dim filepath As String '声明变量保存路径
    Dim sql As String      '声明变量保存查询命令
    '金蝶7.0是通过工作组管理文件进行保护的，相应的权限保存在这个文件中
    '构建连接字符串的时候，应当指定工作组管理文件所在的路径
    '本例中工作组管理文件保存在当前目录下，该文件不可缺少！
    '引用filesystemobject对象
    Dim fs As New FileSystemObject
    filepath = ThisWorkbook.path & "\System.mda"
    If fs.FileExists(filepath) Then
        Else
            MsgBox "缺少金蝶7.0的工作组管理文件System.mda，无法执行下一步操作！", vbExclamation, "请检查！"
            Exit Sub
    End If
    '声明记录集
    Dim rs As New ADODB.Recordset
    '声明ADO连接
    Dim Conn As New ADODB.Connection
    '弹出文件选择对话框
    FileToOpen_N = Application.GetOpenFilename("AIS文件,*.ais", _
         Title:="请指定金蝶7.0数据库文件所在的位置：", MultiSelect:=False)
    '如果选择“打开”选定文件
    If FileToOpen_N <> False Then
        '关闭屏幕更新
        Application.ScreenUpdating = False
        '在状态指示栏进行显示
        Application.StatusBar = "正在连接数据库，请稍候..."
        '连接字符串
        Conn.Open ("Driver={Microsoft Access Driver (*.mdb)};DBQ=" & FileToOpen_N & ";UID=morningstar;PWD=ypbwkfyjhyhgzj;SystemDB=" & filepath & ";")
        '打开记录集，读取凭证库
        rs.Open "select FDate as 日期,FGroup&FNum,FAcctID,FExp,iif(FDebit=0,'贷','借') as fx,FQty,'','',FDebit+FCredit,'','',FDeptID,FEmplID,FCustID from GLVch", Conn, 1, 1
        '以65000条记录为单位，循环读取记录集，因为EXCEL2003以前的版本，
        '单表记录不超过65536，在EXCEL2007中可以修改为100万
        While Not rs.EOF
            '增加一个新表，并将其名称命名为凭证n
            stname = "凭证" & n
            ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(Sheets.Count)
            '设置凭证表的样式，并导入记录
            With ActiveSheet
                .Name = stname
                .Range("A1").Value = "日期"
                .Range("B1").Value = "凭证号数"
                .Range("C1").Value = "科目编码"
                .Range("D1").Value = "摘要"
                .Range("E1").Value = "方向"
                .Range("F1").Value = "数量"
                .Range("G1").Value = "外币名称"
                .Range("H1").Value = "外币"
                .Range("I1").Value = "金额"
                .Range("J1").Value = "国家"
                .Range("K1").Value = "项目代码"
                .Range("L1").Value = "部门代码"
                .Range("M1").Value = "人名代码"
                .Range("N1").Value = "客户代码"
                .Range("O1").Value = "供应商代码"
                .Range("P1").Value = "货物代码"
                .Range("Q1").Value = "结算单"
                .Range("J:Q,H:H,B:E").NumberFormatLocal = "@"
                .Range("H:H,I:I").NumberFormatLocal = "#,##0.00_ "
                .Columns("F:F").NumberFormatLocal = "G/通用格式"
                .Columns("A:A").NumberFormatLocal = "yyyy-m-d"
                .Range("A2").CopyFromRecordset rs, 65000
                .Cells.Font.Size = 10
            End With
            n = n + 1
        Wend
        '清空记录集
        Set rs = Nothing
        '构建新的查询命令，请求余额表中的最大月份、最小月份
        '金蝶7.0的余额表比较特殊，如果是期中建账或者期中读取数据时
        '均要判断最大、最小月份，以便正确生成余额表
        sql = "SELECT max(GLBal.FPeriod) as max, min(GLBal.FPeriod) as min from GLBal"
        '打开记录集
        Set rs = Conn.Execute(sql)
        '声明变量，保存最大、最小月份
        Dim max
        Dim min
        max = rs.Fields(0)
        min = rs.Fields(1)
        '清空记录集
        Set rs = Nothing
        '构建生成余额表的查询语句
        sql = "SELECT GLAcct.FAcctID, GLAcct.FAcctName, GLAcct.FDC, GLBal.FClsID, GLBal.FCyID, GLBal.FPeriod, GLBal.FBegBal, GLBal_1.FPeriod, GLBal_1.FYtdDebit, GLBal_1.FYtdCredit, GLBal_1.FEndBal FROM GLBal INNER JOIN (GLAcct INNER JOIN GLBal AS GLBal_1 ON GLAcct.FAcctID = GLBal_1.FAcctID) ON (GLBal.FAcctID = GLBal_1.FAcctID) AND (GLAcct.FAcctID = GLBal.FAcctID) WHERE (((GLBal.FClsID)=0) AND ((GLBal.FCyID)='*') AND ((GLBal.FPeriod)=" & min & ") AND ((GLBal_1.FPeriod)=" & max & ")AND(GLBal_1.FClsID)=0) AND ((GLBal_1.FCyID)='*')"
        Set rs = Conn.Execute(sql)
        x = 2
        '将记录集中的内容循环读入到“余额表”中
        While Not rs.EOF
            Sheets("余额表").Cells(x, 3).Value = rs.Fields(0)
            Sheets("余额表").Cells(x, 4).Value = rs.Fields(1)
            If rs.Fields(2) = "D" Then
                Sheets("余额表").Cells(x, 5).Value = rs.Fields(6)
                Sheets("余额表").Cells(x, 6).Value = 0
                Sheets("余额表").Cells(x, 9).Value = rs.Fields(10)
                Sheets("余额表").Cells(x, 10).Value = 0
            Else
                Sheets("余额表").Cells(x, 5).Value = 0
                Sheets("余额表").Cells(x, 6).Value = -rs.Fields(6)
                Sheets("余额表").Cells(x, 9).Value = 0
                Sheets("余额表").Cells(x, 10).Value = -rs.Fields(10)
            End If
            Sheets("余额表").Cells(x, 7).Value = rs.Fields(8)
            Sheets("余额表").Cells(x, 8).Value = rs.Fields(9)
            x = x + 1
            rs.MoveNext
        Wend
        '清空记录集
        Set rs = Nothing
        '关闭连接
        Conn.Close
        '清除多余的空格
        delspace
        Application.StatusBar = "OK!"
        MsgBox ("金蝶7.0的凭证数据已导入！")
    Else
        '如果点击“取消”，提示、退出
        MsgBox ("您已选择取消！")
    End If
    '恢复状态提示栏
    Application.StatusBar = False
    '恢复屏幕更新
    Application.ScreenUpdating = True
End Sub