EXE调用mdb实例VB源码

来源:互联网 发布:域名去哪里注册 编辑:程序博客网 时间:2024/05/21 09:45

这是江羽《人事管理软件》中用以启动rsgl-L.mdb的EXE应用程序源码,现在帖出来与大家共同分享,源码如下:

''''============================
''''定义公用模块:
''''============================
Declare Function ShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" (ByVal hwnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) As Long

Public Function TransactSQL(ByVal sql As String) As adodb.Recordset
Dim con As adodb.Connection
Dim rs As adodb.Recordset
Dim strConnection As String
Dim strArray() As String
Dim Iflag As Integer
Set con = New adodb.Connection
Set rs = New adodb.Recordset
On Error GoTo transactSQL_Error
   strConnection = "provider=Microsoft.jet.oledb.4.0;data source=" & App.Path & "/rsgl-L.mdb"
   strArray = Split(sql)
   con.Open strConnection
   If StrComp(UCase$(strArray(0)), "select", vbTextCompare) = 0 Then
      rs.Open Trim$(sql), con, adOpenKeyset, adLockOptimistic
      Set TransactSQL = rs
      Iflag = 1
   Else
      con.Execute sql
      Iflag = 1
   End If
transactSQL_exit:
   Set rs = Nothing
   Set con = Nothing
   Exit Function
transactSQL_Error:
   MsgBox "非法操作,产生如下错误:" & Err.Description
   Iflag = 2
   Resume transactSQL_exit
 End Function

''''========================
''''启动窗体代码:
''''========================
Private Sub Form_Load()
 Dim sql As String
 Dim rs As adodb.Recordset
 sql = "UPDATE Logdata SET [TS]=''''1''''"
 TransactSQL (sql)
    Timer1.Interval = 1000
    Lb.Caption = 0
End Sub

Private Sub Timer1_Timer()
 Lb.Caption = Lb.Caption + 1
 If Lb.Caption = 3 Then
    Timer1.Interval = 0
    Dim sfile As String
    sfile = App.Path & "/rsgl-L.mdb"        ''''在与可执行文件在同一目录,其它类似
    lr = ShellExecute(Me.hwnd, "open", sfile, "", "", a)
    If (lr < 0) Or (lr > 32) Then           ''''打开成功
       End
       Unload frmSplash
      Else
       MsgBox "系统文件丢失或损坏!" & Chr(10) & Chr(13) & "请与系统管理员或开发者:江羽联系!", vbInformation, "文件出错"
       End
       Unload frmSplash
    End If
    End
 End If
End Sub

 -----------------------------------------------------

转载自《江羽个人空间》

http://www.access-cn.com/dvbbs/boke.asp?tanxuanhongyi.showtopic.190.html

原创粉丝点击