📄 main.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{74238AF8-8108-44A9-B3DE-D652F61AB8DC}#2.3#0"; "yfDNetMenu.ocx"
Begin VB.MDIForm MDIForm1
BackColor = &H8000000C&
Caption = "商务名片管理系统"
ClientHeight = 8385
ClientLeft = 2865
ClientTop = 1965
ClientWidth = 9870
Icon = "Main.frx":0000
LinkTopic = "MDIForm1"
LockControls = -1 'True
NegotiateToolbars= 0 'False
WindowState = 2 'Maximized
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 330
Left = 0
TabIndex = 0
Top = 8055
Width = 9870
_ExtentX = 17410
_ExtentY = 582
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin yfDNetMenu.DNetMenu DNetMenu1
Left = 15
Top = 7590
_ExtentX = 847
_ExtentY = 847
BmpCount = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Menu Mshang
Caption = "商家管理"
Begin VB.Menu Mshangxian
Caption = "显示商家列表"
Shortcut = {F1}
End
Begin VB.Menu Mshang_2
Caption = "-"
End
Begin VB.Menu Mshangtian
Caption = "添加商家企业"
Shortcut = {F2}
End
Begin VB.Menu Mshangxiu
Caption = "修改商家企业"
Shortcut = {F3}
End
Begin VB.Menu Mshangshan
Caption = "删除商家企业"
Shortcut = {F4}
End
Begin VB.Menu Mshangfen
Caption = "-"
Visible = 0 'False
End
Begin VB.Menu ShowThisBaifang
Caption = "商家拜访记录"
Visible = 0 'False
End
Begin VB.Menu jhhhh
Caption = "-"
End
Begin VB.Menu Mshangcha
Caption = "查询商家企业"
End
End
Begin VB.Menu MLianxiren
Caption = "联系人"
Begin VB.Menu MLianxirenXianshisuoyou
Caption = "显示所有联系人"
Shortcut = {F5}
End
Begin VB.Menu uu
Caption = "-"
End
Begin VB.Menu MLianxirenTianjia
Caption = "添加联系人资料"
Shortcut = {F6}
End
Begin VB.Menu MLianxirenXiugai
Caption = "修改联系人资料"
Shortcut = {F7}
End
Begin VB.Menu MLianxirenShanchu
Caption = "删除联系人"
Shortcut = ^{F8}
End
Begin VB.Menu MLianxirenFengefu
Caption = "-"
End
Begin VB.Menu FromRenToBaiFang
Caption = "对应商家拜访记录"
End
Begin VB.Menu M_AddRenBaifang
Caption = "添加拜访记录"
End
Begin VB.Menu ggrtt
Caption = "-"
End
Begin VB.Menu MLianxirenChaxun
Caption = "查询联系人资料"
End
End
Begin VB.Menu Mjilu
Caption = "拜访记录"
Begin VB.Menu MALLBAIFANGSHOW
Caption = "所有的拜访记录"
Shortcut = {F9}
End
Begin VB.Menu l12
Caption = "-"
End
Begin VB.Menu Mjilutianjia
Caption = "添加拜访记录"
End
Begin VB.Menu Mjiluxiugai
Caption = "修改拜访记录"
End
Begin VB.Menu Mjilushanchu
Caption = "删除拜访记录"
End
Begin VB.Menu Mjilufengefu
Caption = "-"
Visible = 0 'False
End
Begin VB.Menu Mjiluchaxun
Caption = "查询拜访记录"
Visible = 0 'False
End
End
Begin VB.Menu Mzonghechaxun
Caption = "综合查询"
Begin VB.Menu mchaxundianhuahaoma
Caption = "查询电话号码"
Shortcut = ^Z
End
Begin VB.Menu mcanshushujukutongji
Caption = "数据库资料统计"
End
Begin VB.Menu Mdaochusuoyoulianxirendeshoujihaomahexiaolingtonghaoma
Caption = "导出手机号和小灵通号"
Visible = 0 'False
End
Begin VB.Menu ex_sql
Caption = "公历和农历转换"
End
Begin VB.Menu sqlyuju
Caption = "自定义SQL语句查询"
End
End
Begin VB.Menu murls
Caption = "网址收藏"
Begin VB.Menu murlsshow
Caption = "显示所有网址"
End
Begin VB.Menu m_urls
Caption = "-"
End
Begin VB.Menu murlsadd
Caption = "添加网络地址"
End
Begin VB.Menu murlsedit
Caption = "修改网络地址"
End
Begin VB.Menu murlsdel
Caption = "删除网络地址"
End
End
Begin VB.Menu mricheng
Caption = "日程提醒"
Visible = 0 'False
End
Begin VB.Menu MCanchu
Caption = "控制中心"
Begin VB.Menu mcanshubengongsi
Caption = "本公司人员设置"
End
Begin VB.Menu MDYBDHMD
Caption = "更换数据库文件"
End
Begin VB.Menu mgongneng
Caption = "程序参数设定"
End
Begin VB.Menu M_软件界面配色
Caption = "软件界面配色"
Visible = 0 'False
End
Begin VB.Menu fdfdfdfd
Caption = "-"
End
Begin VB.Menu M_pswdset
Caption = "软件密码设置"
End
Begin VB.Menu mcanshu_
Caption = "-"
End
Begin VB.Menu 清空数据库
Caption = "整理数据库"
End
Begin VB.Menu MBACKUP
Caption = "备份数据库"
Visible = 0 'False
End
Begin VB.Menu ToExcel
Caption = "导出数据到 excel"
End
Begin VB.Menu trgrg
Caption = "-"
Visible = 0 'False
End
Begin VB.Menu opencdrom
Caption = "打开光驱"
Visible = 0 'False
End
Begin VB.Menu closecdrom
Caption = "关闭光驱"
Visible = 0 'False
End
End
Begin VB.Menu mchengxushuoming
Caption = "程序说明"
Begin VB.Menu mruanjianshuoming
Caption = "软件说明"
Shortcut = +{F1}
End
Begin VB.Menu mupdate
Caption = "软件最新公告"
End
End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/12/24
'描 述：商务名片及客户资料管理系统 Ver 1.73
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Private Sub closecdrom_Click()
Dim retValue As Long
retValue = mciSendString("set CDAudio door closed", "", 127, 0)
End Sub
Private Sub ex_sql_Click()
Load FrmNongLi
FrmNongLi.Show
End Sub
Private Sub FromRenToBaiFang_Click()
On Error GoTo ddddddd
If Val(FrmShowAllRen.MSFlexGrid1.TextMatrix(FrmShowAllRen.MSFlexGrid1.RowSel, 0)) = 0 Then
Exit Sub
Else
Dim d As Database
Dim r As Recordset
Set d = OpenDatabase(MdbPath)
Set r = d.OpenRecordset("select * from ren where id =" & FrmShowAllRen.MSFlexGrid1.TextMatrix(FrmShowAllRen.MSFlexGrid1.RowSel, 0))
Dim renid As Double
If r.RecordCount > 0 Then
r.MoveLast
r.MoveFirst
If r.RecordCount > 1 Then
MsgBox "数据库出现了紊乱：当按照联系人的ID来从数据库中查询所属单位的ID的时候，找到了不唯一的记录，相同的ID的联系人应该是唯一的，数据库错误，请和程序提供者联系。", vbInformation, "不可处理的错误中断"
r.Close
d.Close
Set r = Nothing
Set d = Nothing
Exit Sub
ElseIf r.RecordCount = 1 Then
If IsNull(r!所属企业) = False Then
renid = r!所属企业
r.Close
d.Close
Set r = Nothing
Set d = Nothing
Else
renid = 0
r.Close
d.Close
Set r = Nothing
Set d = Nothing
End If
End If
ElseIf r.RecordCount = 0 Then
renid = 0
r.Close
d.Close
Set r = Nothing
Set d = Nothing
End If
If Val(renid) = 0 Then
MsgBox "定位联系人的所属单位的ID标志的时候出现了错误，无法解析，传递过来的值为空！可能是该联系人不属于任何单位。", vbInformation, "联系人所属单位取值失败"
Exit Sub
End If
If form13show = True Then
Form13.SetFocus
Else
Load Form13
Form13.Show
End If
Form13.Frame3.Visible = True
Form13.Label5.Caption = "正在准备读取数据库 ... "
Form13.Label5.Caption = "正在打开数据库 ... "
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(MdbPath)
Set rs = db.OpenRecordset("select * from baifang where 企业ID号 =" & renid & " order by id desc")
If rs.RecordCount > 0 Then '''''''''''''''''''''''''''''''''''这段代码为循环显示拜访记录到列表中。''''''''''''''''''
Dim i As Integer
Form13.Label5.Caption = "数据库已经打开，正在读取数据 ... "
Form13.MSFlexGrid1.Cols = 5
Form13.Text7.Text = Val(renid)
rs.MoveLast
rs.MoveFirst
Form13.MSFlexGrid1.Rows = rs.RecordCount + 1
Form13.MSFlexGrid1.ColWidth(0) = 500
Form13.MSFlexGrid1.ColWidth(1) = 1000
Form13.MSFlexGrid1.ColWidth(2) = 1200
Form13.MSFlexGrid1.ColWidth(3) = 1200
Form13.MSFlexGrid1.ColWidth(4) = 7800
Form13.MSFlexGrid1.TextMatrix(0, 0) = "ID"
Form13.MSFlexGrid1.TextMatrix(0, 1) = "拜访时间"
Form13.MSFlexGrid1.TextMatrix(0, 2) = "受访人"
Form13.MSFlexGrid1.TextMatrix(0, 3) = "拜访人"
Form13.MSFlexGrid1.TextMatrix(0, 4) = "内容"
For i = 1 To rs.RecordCount
Form13.Label5.Caption = "正在加载数据，请稍候 ... " & i & " " & "/" & rs.RecordCount
Form13.MSFlexGrid1.TextMatrix(i, 0) = rs!id
Form13.MSFlexGrid1.TextMatrix(i, 1) = rs!拜访时间
Form13.MSFlexGrid1.TextMatrix(i, 2) = rs!受访人
Form13.MSFlexGrid1.TextMatrix(i, 3) = rs!拜访人
Form13.MSFlexGrid1.TextMatrix(i, 4) = rs!内容
If rs.EOF Then
Exit For
Else
rs.MoveNext
End If
DoEvents
Next i
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -