📄 用mapi控件批量发送文件.htm
字号:
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<!-- saved from url=(0032)http://www.dreamdee.cn.gs/19.htm -->
<HTML><HEAD><TITLE>用MAPI控件批量发送文件</TITLE><!-- #BeginTemplate "/Templates/file.dwt" --><!-- #BeginEditable "doctitle" --><!-- #EndEditable -->
<META content="text/html; charset=gb2312" http-equiv=Content-Type>
<STYLE>BODY {
Scrollbar-Face-Color: #006600; scrollbar-highlight-color: #009999; scrollbar-shadow-color: #009999; scrollbar-3dlight-color: #006600; scrollbar-arrow-color: #00FFFF; scrollbar-track-color: #009999; scrollbar-darkshadow-color: #006600
}
</STYLE>
<META content="MSHTML 5.00.3700.6699" name=GENERATOR></HEAD>
<BODY bgColor=#0099cc text=#ffffff>
<TABLE border=1 borderColor=#009966 cellPadding=0 cellSpacing=0 width=746>
<TBODY>
<TR>
<TD bgColor=#00ccff
borderColor=#0000ff><!-- #BeginEditable "body" -->
<DIV align=center><FONT color=#ff0000 size=+1>用MAPI控件批量发送文件</FONT> </DIV>
<P>Option Explicit<BR>Private Declare Function RasHangUp Lib
"RasApi32.DLL" Alias "RasHangUpA" (ByVal hRasConn As Long) As
Long<BR>Private Declare Function RasEnumConnections Lib "RasApi32.DLL"
Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As Long,
lpcConnections As Long) As Long </P>
<P>Const RAS95_MaxEntryName = 256<BR>Const RAS95_MaxDeviceName =
128<BR>Const RAS_MaxDeviceType = 16</P>
<P>Private Type RASCONN95<BR>'set dwsize to 412<BR>dwSize As
Long<BR>hRasConn As Long<BR>szEntryName(RAS95_MaxEntryName) As
Byte<BR>szDeviceType(RAS_MaxDeviceType) As
Byte<BR>szDeviceName(RAS95_MaxDeviceName) As Byte<BR>End Type</P>
<P>Dim nodX As Node<BR>Dim iIndex, i, j, LineCount, nodi, m As
Integer<BR>Dim moDragNode As Object<BR>Dim finame, linetex, S As
String<BR>Dim Get_File As String<BR>Dim oldname(1 To 100) As String<BR>Dim
Response As Integer</P>
<P>Dim lngRetCode As Long<BR>Dim lpcb As Long<BR>Dim lpcConnections As
Long<BR>Dim intArraySize As Integer<BR>Dim intLooper As Integer</P>
<P>Dim ti</P>
<P></P>
<P>Private Sub addemail_Click()<BR>add_email<BR>End Sub</P>
<P>Private Sub addfile_Click()<BR>add_file<BR>End Sub</P>
<P>Private Sub addtools_Click()<BR>nodi = nodi + 1<BR>add_tools<BR>End
Sub</P>
<P>Private Sub deltools_Click()<BR>nodi = nodi -
1<BR>TreeView1.Nodes.Remove iIndex<BR>End Sub</P>
<P>Private Sub exit_Click()<BR>End<BR>End Sub</P>
<P>Private Sub faso_Click()<BR>EmailTo<BR>End Sub</P>
<P>Private Sub Form_Load()<BR>For i = 0 To 3<BR>Text1(i).Visible =
False<BR>Next<BR>Set nodX = TreeView1.Nodes.Add(, , , "基本设置 ", 1)<BR>Set
nodX = TreeView1.Nodes.Add(1, tvwChild, , "发信内容 ", 2)<BR>Set nodX =
TreeView1.Nodes.Add(1, tvwChild, , "收信人地址", 3)<BR>Set nodX =
TreeView1.Nodes.Add(1, tvwChild, , "增加附件", 4)<BR>Set nodX =
TreeView1.Nodes.Add(, , , "信息提示 ", 5)<BR>Text1(1).Text = "请在这里输入信件的内容" +
vbCrLf + vbCrLf + "，您好！"<BR>Text1(2).Text = "# 请在这里输入你要发送的Email的地址" +
vbCrLf + "# 注意每个Email为一行" + vbCrLf + vbCrLf + "yingzi007@21cn.com" +
vbCrLf + "yingzi008@21cn.com"<BR>Text1(0).Text = "软件运行时间：" + Str(Time) +
vbCrLf<BR>End Sub</P>
<P><BR>Private Sub new_Click()<BR>newfile<BR>End Sub</P>
<P>Private Sub open_Click()<BR>openfile<BR>End Sub</P>
<P>Private Sub save_Click()<BR>savefile<BR>End Sub</P>
<P><BR>Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer,
Shift As Integer)<BR>If KeyCode = vbKeyA And Shift = vbCtrlMask
Then<BR>Text1(Index).SelStart = 0<BR>Text1(Index).SelLength =
Len(Text1(Index).Text)<BR>End If</P>
<P>End Sub</P>
<P>Private Sub Toolbar1_ButtonClick(ByVal Button As
MSComctlLib.Button)<BR>Select Case Button.Key<BR>Case Is =
"new"<BR>newfile<BR>Case Is = "open"<BR>openfile<BR>Case Is =
"save"<BR>savefile<BR>Case Is = "mato"<BR>EmailTo</P>
<P>End Select<BR>End Sub</P>
<P>Private Sub TreeView1_Click()<BR>On Error Resume Next<BR>iIndex =
TreeView1.SelectedItem.Index<BR>Select Case iIndex<BR>Case 1<BR>For i = 0
To 3<BR>Text1(i).Visible = False<BR>Next</P>
<P>Case 2<BR>For i = 0 To 3<BR>Text1(i).Visible =
False<BR>Next<BR>Text1(1).Visible = True<BR>Text1(3).Visible =
True<BR>Case 3<BR>For i = 0 To 3<BR>Text1(i).Visible =
False<BR>Next<BR>Text1(2).Visible = True<BR>Case 5<BR>For i = 0 To
3<BR>Text1(i).Visible = False<BR>Next<BR>Text1(0).Visible = True<BR>End
Select<BR>End Sub</P>
<P>Sub add_tools()<BR>Dim i, j As Integer<BR>i = 1<BR>j = 1<BR>On Error
GoTo err<BR>CommonDialog1.ShowOpen<BR>finame =
CommonDialog1.FileName<BR>oldname(nodi) = finame<BR>If finame <> ""
Then<BR>While i <> 0<BR>i = InStr(i + 1, finame, "\")<BR>If i
<> 0 Then<BR>j = i<BR>End If<BR>Wend<BR>finame = Right(finame,
Len(finame) - j)<BR>Set nodX = TreeView1.Nodes.Add(4, tvwChild, , finame,
11)<BR>finame = ""<BR>End If<BR>Exit Sub<BR>err:<BR>finame = ""<BR>End
Sub</P>
<P>Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As
Single, y As Single)</P>
<P>Dim nod As Node</P>
<P>If Button = vbRightButton Then '检测鼠标的点击</P>
<P>Set nod = TreeView1.HitTest(x, y) '返回你所点击的Node对象的坐标</P>
<P>On Error GoTo EmptyNode</P>
<P>nod.Selected = True ' 设置你所点击的Node对象被选中</P>
<P>On Error GoTo 0</P>
<P>'<<下面是你的自定义菜单>><BR>If iIndex > 5 Then deltools.Visible =
True</P>
<P>Me.PopupMenu mymenu</P>
<P>deltools.Visible = False</P>
<P>EmptyNode:</P>
<P>On Error GoTo 0</P>
<P>End If</P>
<P>End Sub</P>
<P>Sub add_email()<BR>On Error GoTo err<BR>CommonDialog1.Filter =
"Text(*.txt)|*.txt"<BR>CommonDialog1.ShowOpen<BR>finame =
CommonDialog1.FileName<BR>If FileLen(finame) < 1024 * 10
Then<BR>Text1(2).Text = ""<BR>On Error GoTo file<BR>Open finame For Input
As #1<BR>linetex = Input(LOF(1), #1)<BR>Text1(2).Text = linetex<BR>Close
#1<BR>Else<BR>MsgBox "文件过大，装载失败！！"<BR>End If</P>
<P><BR>Exit Sub<BR>err:<BR>finame = ""</P>
<P>Exit Sub<BR>file:<BR>Close #1<BR>Open finame For Input As #1<BR>Do
While Not EOF(1)<BR>Line Input #1, linetex<BR>Text1(2).Text =
Text1(2).Text + linetex + vbCrLf<BR>Loop<BR>Close #1<BR>End Sub</P>
<P>Sub add_file()</P>
<P>On Error GoTo err<BR>CommonDialog1.Filter =
"Text(*.txt)|*.txt"<BR>CommonDialog1.ShowOpen<BR>finame =
CommonDialog1.FileName<BR>If FileLen(finame) < 1024 * 10
Then<BR>Text1(1).Text = ""<BR>On Error GoTo file<BR>Open finame For Input
As #1<BR>linetex = Input(LOF(1), #1)<BR>Text1(1).Text = linetex<BR>Close
#1<BR>Else<BR>MsgBox "文件过大，装载失败！！"<BR>End If</P>
<P><BR>Exit Sub<BR>err:<BR>finame = ""</P>
<P>Exit Sub<BR>file:<BR>Close #1<BR>Open finame For Input As #1<BR>Do
While Not EOF(1)<BR>Line Input #1, linetex<BR>Text1(1).Text =
Text1(1).Text + linetex + vbCrLf<BR>Loop<BR>Close #1</P>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -