mdb.bas

此源码是针对配套的光学标记阅读机使用

Attribute VB_Name = "Module1"
Option Explicit
Public strUserName As String                   '用户名称
Public iflag As Integer                        '是否连接成功标志
Public ichangeFlag As Integer                  '修改标志
Public strPublicSQL As String                  '传递SQL字符串
Public gUserName As String                        '保存用户名称
Public flag As Integer                            '添加和修改的标志
Public sSheetName As String '：要导出资料的文件名称 (Sheet name)，例如 Sheet1
Public sExcelPath As String '：要导出资料的 Excel 档案路径名称 (Workbook path)，例如 C:\book1.xls
Public sAccessTable As String '：要导入的 Access Table 名称，例如 TestTable
Public sAccessDBPath As String '：要导入的 Access 档案路径名称，例如 C:\Test.mdb





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
  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 & "\shfd.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
Public Sub TabToEnter(key As Integer)
    If key = 13 Then                            '判断是否为回车键
    SendKeys "{TAB}"                            '转换为Tab键
    End If
End Sub


Public Function getRS(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
Set con = New ADODB.Connection                  '创建连接
Set rs = New ADODB.Recordset                    '创建记录集
On Error GoTo getRS_Error
    strConnection = "Provider=Microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\"
    strConnection = strConnection & "shfd.mdb"
    strArray = Split(sql)
    con.Open strConnection                      '打开连接
        rs.Open Trim$(sql), con, adOpenKeyset, adLockOptimistic
        Set getRS = rs                          '返回记录集
        iflag = 1
getRS_Exit:
    Set rs = Nothing
    Set con = Nothing
    Exit Function
getRS_Error:
    MsgBox "查询错误：" & Err.Description
    iflag = 2
    Resume getRS_Exit
End Function