设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 450|回复: 0
打印 上一主题 下一主题

[求助]VBA CODE 版本? Baan的1996的ExcelVBA&nbs

[复制链接]
跳转到指定楼层
1#
发表于 2002-9-14 01:29:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
Hi all,
  我看了好久,还是没有完全读懂这个VBA代码,请大家给点提示,程序的作用里面已经有说明。这些东东是VB的啥语句里有说明([U]ParseExecFunction\timout\functioncall\returnvalue\quit[/U]).我的VBA手册里没有找到相关说明。


Dim BaanObj As Object
Dim B_function As String
Dim B_function2 As String
Dim Query As String
Dim user As String
Dim temp_string As String
Dim query_id As Long
Dim RetVal As Long

Sub GetBaanUsers()
    ' This example will fill the spreadsheet with the names of BAAN IV users,
    ' with the criterium: user name > "tools"
    ' This macro parses the following string:
    ' "select ttaad200.user from ttaad200 where ttaad200.user > "tools""
    ' The DLL "ottdllsql_query" contains a function to convert this string to a Baan query and
    ' other functions to parse and execute the query. The DLL also contains functions to retrieve
    ' the result of the query, e.g. function "olesql_getstring".
    On Error GoTo CannotCreateBaan
   
    'run Baan Application
    Set BaanObj = CreateObject("Baan4.Application")
    ThisWorkbook.Sheets("Users").Activate
    BaanObj.Timeout = 10‘Catt:timeout?
    On Error GoTo BaanAutomationError
   
    ' form the string to Visual Basic format. Mind how quotes (Chr(34)) are put in the string
    Query = "select ttaad200.user from ttaad200 where ttaad200._compnr=000 and ttaad200.user > " & Chr(34) & Chr(34) & "tools" & Chr(34) & Chr(34)
   
    B_function = "olesql_parse(" & Chr(34) & Query & Chr(34) & ")"
    ' execute the function olesql_parse("select ttaad200.user from ttaad200 where ttaad200.user > "tools"")
    ' from DLL ottdllsql_query
    BaanObj.ParseExecFunction "ottdllsql_query", B_function
    ' If this function fails the ReturnValue is equal to zero, otherwise
    ' the function olesql_parse returns a identification number of the query
    ' Convert the (string) ReturnValue to a long variable using the function Val
    query_id = Val(BaanObj.ReturnValue)
    If query_id = 0 Then
        MsgBox "function olesql_parse fails"
        GoTo BaanAutomationError
    End If
    ' The function olesql_fetch reads one query result, in this example the (string) value of ttaad200.user
    ' The identification number of the query must be passed as argument to this function
    B_function = "olesql_fetch(" & query_id & ")"
    BaanObj.ParseExecFunction "ottdllsql_query", B_function
    temp_string = "ttaad200.user"
    user = String(10, " ")
    ' The function olesql_getstring retrieves the query result and stores it in the second argument,
    ' a 'call by reference' argument. Note that the second argument must be large enough to fill in the result
    B_function2 = "olesql_getstring(" & Chr(34) & temp_string & Chr(34) & "," & Chr(34) & user & Chr(34) & ")"
    BaanObj.ParseExecFunction "ottdllsql_query", B_function2
   
    ' search returned string in the function call (call by reference argument)
    temp_string = BaanObj.FunctionCall
    user = Mid(temp_string, 35, 10)
    user = Trim(user)
   
    Row = 1
    Column = 6
    If user = "" Then MsgBox ("No users found")
    While (user <> "")
        ' fill spreadsheet
        Worksheets("Users").Cells(Row, Column) = user
        Row = Row + 1
        If Row > 10 Then
            Row = 1
            Column = Column + 1
        End If
        
        ' Read next query result. If this function fails, the ReturnValue is not equal to zero
        BaanObj.ParseExecFunction "ottdllsql_query", B_function
        If BaanObj.ReturnValue = 0 Then
            ' retrieve query result and store it in the second argument of the function olesql_getstring
            BaanObj.ParseExecFunction "ottdllsql_query", B_function2
            temp_string = BaanObj.FunctionCall
            ' the second argument (user name) can be retrieved from position 35 of the FunctionCall
            user = Mid(temp_string, 35, 10)
            user = Trim(user)    ' removes spaces from text string
        ElseIf BaanObj.ReturnValue = 110 Then       ' end of set
   
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-29 22:55 , Processed in 0.076054 second(s), 24 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表