这个执行ado的SQL语句的函数ExecuteSQL如下

Question

这个执行ado的SQL语句的函数ExecuteSQL如下:Public Function ConnectString() As String
    ConnectString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & App.Path & "\Data.mdb"
End FunctionPublic Function ExecuteSQL(strSQL As String, strMsg As String, Optional rst As Object) As Integer
    On Error GoTo ExitFunction
    Dim cn As ADODB.connection
    Dim rs As ADODB.Recordset
    Dim sTokens() As String
    
    ExecuteSQL = 1
    
    sTokens = Split(strSQL)
    Set cn = New ADODB.connection
    cn.CursorLocation = adUseClient
    cn.Open ConnectString
    
    If InStr("INSERT,UPDATE,DELETE", UCase(sTokens(0))) > 0 Then
        cn.Execute strSQL
    Else
        Set rs = New ADODB.Recordset
        rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic
        Set rst = rs.Clone
    End If
    
    
outp:
    Set rs = Nothing
    Set cn = Nothing
    Exit Function
ExitFunction:
    ExecuteSQL = 0
    strMsg = Err.Description
    GoTo outp
End Function

Answer 1

http://community.csdn.net/Expert/topic/5760/5760251.xml?temp=.9165003

Answer 2

我认为改成这样比较好
Public   cn   As   ADODB.connection sub main()
        Set   cn   =   New   ADODB.connection 
        cn.CursorLocation   =   adUseClient 
        cn.Open   ConnectString 
end subPublic   Function   ConnectString()   As   String 
        ConnectString   =   "Provider=Microsoft.Jet.OLEDB.3.51;Persist   Security   Info=False;Data   Source="   &   App.Path   &   "\Data.mdb" 
End   Function Public   Function   ExecuteSQL(strSQL   As   String,   strMsg   As   String,   Optional   rst   As   Object)   As   Long 
        On   Error   GoTo   ExitFunction 
        Dim   rs   As   ADODB.Recordset 
        Dim   sTokens()   As   String 
        
        ExecuteSQL   =   1 
        
        sTokens   =   Split(strSQL) 
        
        If   InStr("INSERT,UPDATE,DELETE",   UCase(sTokens(0)))   >   0   Then 
                cn.Execute   strSQL 
        Else 
                Set   rs   =   New   ADODB.Recordset 
                rs.Open   strSQL,   cn,   adOpenKeyset,   adLockOptimistic 
                Set   rst   =   rs.Clone 
        End   If 
        
        
outp: 
        Set   rs   =   Nothing 
        Exit   Function 
ExitFunction: 
        ExecuteSQL   =   0 
        strMsg   =   Err.Description 
        ReSume   outp 
End   Function 

Answer 3

我认为改成这样比较好 
public   strSQL as string
public   strMsg as string
Public   cn   As   ADODB.connection  sub main() 
        Set   cn   =   New   ADODB.connection  
        cn.CursorLocation   =   adUseClient  
        cn.Open   ConnectString  
end sub Public   Function   ConnectString()   As   String  
        ConnectString   =   "Provider=Microsoft.Jet.OLEDB.3.51;Persist   Security   Info=False;Data   Source="   &   App.Path   &   "\Data.mdb"  
End   Function  Public   Function   ExecuteSQL(strSQL   As   String,   strMsg   As   String,   Optional   rst   As   Object)   As   Long  
        On   Error   GoTo   ExitFunction  
        Dim   sTokens()   As   String  
         
        ExecuteSQL   =   1  
         
        sTokens   =   Split(strSQL)  
         
        If   InStr("INSERT,UPDATE,DELETE",   UCase(sTokens(0)))    >   0   Then  
                cn.Execute   strSQL  
        Else   
                Set   rst   =    cn.Execute(strSQL)
        End   If          Exit   Function  
ExitFunction:  
        ExecuteSQL   =   0  
        strMsg   =   Err.Description  
End   Function  private sub ShowData()
    on error goto err
    dim rst as object
    dim i as integer
    strSQL="select * from tUser"
    if ExecuteSQL(strSQL,strMsg,rst)=0 then goto err
    for i=1 to rst.recordcount()
       cbouser.additem rst("Name") & ""
       rst.movenext
    next
    strSQL="select * from tCustomer"
    if ExecuteSQL(strSQL,strMsg,rst)=0 then goto err
    LoadRsttoGrid vsf,rst
err:
    set rst=nothing
    if err.number<>0 then ShowErrMsg
end subPublic sub ShowErrMsg()
        msgbox "错误号：" & err.number & vbcrlf & "错误描述：" & err.descripment ,vbokonly+vbinformation,"系统提示"
end sub

Answer 4

Public   Sub   LoadRsttoGrid(fg   As   VSFlexGrid,   rst   As   ADODB.Recordset,   Optional   ByVal   ListNo   As   Boolean   =   True) 
        Dim   lngrow   As   Long,   lngcol   As   Long 
        Dim   i   As   Long,   j   As   Long 
        Dim   strItem   As   String         lngrow   =   rst.RecordCount 
        If   rst.Fields.Count   >   fg.Cols   Then 
                lngcol   =   fg.Cols   -   1 
        Else 
                lngcol   =   rst.Fields.Count   -   1 
        End   If         With   fg 
                .rows   =   1 
                For   i   =   1   To   lngrow 
                        If   ListNo   =   True   Then 
                                strItem   =   i   &   Chr(9) 
                        Else 
                                strItem   =   "" 
                        End   If 
                        
                        For   j   =   0   To   lngcol 
                                strItem   =   strItem   &   rst(j)   &   Chr(9) 
                        Next 
                        
                        .AddItem   Mid(strItem,   1,   Len(strItem)   -   1) 
                        
                        rst.movenext 
                Next 
        End   With 
        
End   Sub

Answer 5

Public   Sub   LoadRsttoGrid(fg   As   VSFlexGrid,   rst   As   ADODB.Recordset,   Optional   ByVal   ListNo   As   Boolean   =   True) 
        Dim   lngrow   As   Long,   lngcol   As   Long 
        Dim   i   As   Long,   j   As   Long 
        Dim   strItem   As   String         lngrow   =   rst.RecordCount 
        If   rst.Fields.Count   >   fg.Cols   Then 
                lngcol   =   fg.Cols   -   1 
        Else 
                lngcol   =   rst.Fields.Count   -   1 
        End   If         With   fg 
                .rows   =   1 
                For   i   =   1   To   lngrow 
                        If   ListNo   =   True   Then 
                                strItem   =   i   &   Chr(9) 
                        Else 
                                strItem   =   "" 
                        End   If 
                        
                        For   j   =   0   To   lngcol 
                                strItem   =   strItem   &   rst(j)   &   Chr(9) 
                        Next 
                        
                        .AddItem   Mid(strItem,   1,   Len(strItem)   -   1) 
                        
                        rst.movenext 
                Next 
        End   With 
        
End   Sub