module1.bas

部门在用的用户申告系统

Attribute VB_Name = "Module1"
Public db As Database
Public Sub Main()
On Error GoTo err
 If Not App.PrevInstance Then
   Set db = OpenDatabase(App.Path & "\yhsg.mdb")
   frmLogin.Show
Else
   MsgBox "工程部综合管理系统已经运行！", vbInformation, "信息"
End If

Exit Sub
err:
    MsgBox "连接数据库失败", vbExclamation, "连接失败"
    Exit Sub
End Sub

Public Function cxlxrid(lxrname As String) As String
'从右边取出jflxid
Dim zc As Long '字符总长度
Dim i As Integer '第几位
Dim j As Integer
Dim linshistr As String '临时值
zc = Len(lxrname)
For i = 1 To zc
    If Mid(lxrname, i, 1) <> "@" Then
       linshistr = Mid(lxrname, i, 1)
    Else
       j = zc - i
       lxrname = Right(lxrname, j)
       Exit For
    End If
Next i
cxlxrid = lxrname
End Function

Public Function cxlxrid2(lxrname2 As String) As String
'从右边取出联系人
Dim zc As Long '字符总长度
Dim i As Integer '第几位
Dim j As Integer
Dim linshistr As String '临时值
zc = Len(lxrname2)
For i = 1 To zc
    If Mid(lxrname2, i, 1) <> "@" Then
       linshistr = Mid(lxrname2, i, 1)
    Else
       j = i - 1
       lxrname2 = Left(lxrname2, j)
       Exit For
    End If
Next i
cxlxrid2 = lxrname2
End Function