?? 郵件發送.frm
字號:
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "信息提示 ", 5)
Text1(1).Text = "請在這里輸入信件的內容" + vbCrLf + vbCrLf + "您好!"
Text1(2).Text = "請在這里輸入你要發送的Email的地址"
Text1(0).Text = "記錄時間:" + Str(Time) + vbCrLf
End Sub
Private Sub new_Click()
newfile
End Sub
Private Sub open_Click()
openfile
End Sub
Private Sub save_Click()
savefile
End Sub
Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyA And Shift = vbCtrlMask Then
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(Index).Text)
End If
End Sub
Private Sub TreeView1_Click()
On Error Resume Next
iIndex = TreeView1.SelectedItem.Index
Select Case iIndex
Case 1
For i = 0 To 3
Text1(i).Visible = False
Next
Case 2
For i = 0 To 3
Text1(i).Visible = False
Next
Text1(1).Visible = True
Text1(3).Visible = True
Case 3
For i = 0 To 3
Text1(i).Visible = False
Next
Text1(2).Visible = True
Case 5
For i = 0 To 3
Text1(i).Visible = False
Next
Text1(0).Visible = True
End Select
End Sub
Sub add_tools()
Dim i, j As Integer
i = 1
j = 1
On Error GoTo err
CommonDialog1.ShowOpen
finame = CommonDialog1.FileName
oldname(nodi) = finame
If finame <> "" Then
While i <> 0
i = InStr(i + 1, finame, "\")
If i <> 0 Then
j = i
End If
Wend
finame = Right(finame, Len(finame) - j)
Set nodX = TreeView1.Nodes.Add(4, tvwChild, , finame, 11)
finame = ""
End If
Exit Sub
err:
finame = ""
End Sub
Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim nod As Node
If Button = vbRightButton Then '檢測鼠標的點擊
Set nod = TreeView1.HitTest(x, y) '返回你所點擊的Node對象的坐標
On Error GoTo EmptyNode
nod.Selected = True ' 設置你所點擊的Node對象被選中
On Error GoTo 0
'<<下面是你的自定義菜單>>
'If iIndex > 5 Then deltools.Visible = True
'Me.PopupMenu mymenu
'deltools.Visible = False
EmptyNode:
On Error GoTo 0
End If
End Sub
Sub EmailTo()
Text1(0).Text = Text1(0).Text + "郵件發送時間:" + Str(Time) + vbCrLf
MAPISession1.LogonUI = True
MAPISession1.DownLoadMail = False
'test
'If lpcConnections <> 0 Then
On Error GoTo error1
On Error GoTo error1
MAPISession1.SignOn
GetText
For i = 0 To LineCount
Call GetLine(Text1(2).hWnd, i, S)
j = InStr(1, S, "@")
If j = 0 Then S = ""
If S <> "" Then
Debug.Print S
MAPIMessages1.SessionID = MAPISession1.SessionID
MAPIMessages1.Compose
MAPIMessages1.RecipAddress = S '收信人地址
MAPIMessages1.ResolveName
MAPIMessages1.MsgSubject = Text1(3).Text
MAPIMessages1.MsgNoteText = Text1(1).Text
For m = 1 To nodi
MAPIMessages1.AttachmentIndex = m - 1
MAPIMessages1.AttachmentPathName = oldname(m)
Next
MAPIMessages1.Send
End If
Next
Text1(0).Text = Text1(0).Text + "郵件信息:發信人名稱 " + MAPIMessages1.MsgOrigDisplayName + vbCrLf
Text1(0).Text = Text1(0).Text + "郵件信息:發信人地址 " + MAPIMessages1.MsgOrigAddress + vbCrLf
Text1(0).Text = Text1(0).Text + "郵件信息:發送對象共有" + Str(LineCount) + "人" + vbCrLf
'End If
ti = Timer
Me.Enabled = False
MsgBox "郵件準備發送,請等待12秒"
Do While Timer < ti + 12 '這個語句的意義在于,讓MAPI控件有足夠處理信息的時間
DoEvents ' 將控制讓給其他程序。
Loop
Me.Enabled = True
MsgBox "郵件開始發送"
Me.Caption = "郵件"
MAPISession1.SignOff
'End If
Exit Sub
error1:
If err = 48389 Then
MsgBox "MAPI錯誤,請不要把FoxMail設為IE的默認郵件發送程序", 48
Text1(0).Text = Text1(0) + "發送錯誤:把FoxMail設置為IE的默認郵件程序" + vbCrLf
Else
MsgBox err & Error(err)
Text1(0).Text = Text1(0) + "發送錯誤:" + Error(err) + vbCrLf
End If
End Sub
Sub GetText()
LineCount = SendMessageLong(Text1(2).hWnd, EM_GETLINECOUNT, 0&, 0&)
End Sub
Sub newfile()
'ynsave
'If Response = 6 Then
'savefile
'Else
TreeView1.Nodes.Remove 1
For i = 1 To 3
Text1(i).Visible = False
Next
Set nodX = TreeView1.Nodes.Add(, , , "基本設置 ", 1)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "信件內容 ", 2)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "收信人地址", 3)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "附件", 4)
Set nodX = TreeView1.Nodes.Add(1, tvwChild, , "錯誤提示 ", 5)
Text1(1).Text = "請在這里輸入信件的內容" + vbCrLf + vbCrLf + "您好!"
Text1(2).Text = " 請在這里輸入你要發送的Email的地址"
Text1(3).Text = "請在這里輸入信件的主題"
'End If
End Sub
Sub savefile()
On Error GoTo err
CommonDialog1.Flags = &H2
CommonDialog1.Filter = "Text(*.txt)|*.txt"
CommonDialog1.ShowSave
If CommonDialog1.FileName <> "" Then
Dim savefile(1 To 4) As String
For i = 1 To nodi
savefile(1) = savefile(1) + "◎◎" + oldname(i) + "◎◎" + vbCrLf
Next
savefile(2) = "○○" + Text1(3).Text + "○○"
savefile(3) = "●●" + Text1(1).Text + "●●"
savefile(4) = "◇◇" + Text1(2).Text + "◇◇"
Open CommonDialog1.FileName For Output As #1
Print #1, "□□□□□" + vbCrLf + savefile(1) + vbCrLf + savefile(2) + vbCrLf + savefile(3) + vbCrLf + savefile(4)
Close #1
End If
Exit Sub
err:
CommonDialog1.FileName = ""
End Sub
Sub openfile()
ynsave
If Response = 6 Then
savefile
End If
Dim StrName, StrTe, LenStrTe As String
On Error GoTo err
CommonDialog1.Filter = "Text(*.txt)|*.txt"
CommonDialog1.ShowOpen
StrName = CommonDialog1.FileName
Open StrName For Input As #1
On Error GoTo errfi
Line Input #1, StrTe
Close #1
If StrTe <> "□□□□□" Then
MsgBox "文件格式錯誤"
Exit Sub
Else
StrTe = ""
Open StrName For Input As #1
StrTe = Input(LOF(1), #1)
Close #1
End If
Exit Sub
err:
StrName = ""
Exit Sub
errfi:
Close #1
Open StrName For Input As #1
Do While Not EOF(1)
Line Input #1, StrTe
LenStrTe = LenStrTe + StrTe + vbCrLf
Loop
Close #1
Call GetFile("○○", LenStrTe, Get_File)
Text1(3).Text = Get_File
Call GetFile("●●", LenStrTe, Get_File)
Text1(1).Text = Get_File
Call GetFile("◇◇", LenStrTe, Get_File)
Text1(2).Text = Get_File
End Sub
Sub GetFile(GetStr As String, FullStr As String, GetStrAl As String)
Dim Inte, InTem(1 To 2) As Integer
'Dim GetStrAl As String
Inte = InStr(Inte + 1, FullStr, GetStr)
InTem(1) = Inte
Inte = InStr(Inte + 1, FullStr, GetStr)
InTem(2) = Inte
GetStrAl = Mid(FullStr, InTem(1) + Len(GetStr), InTem(2) - InTem(1) - Len(GetStr))
End Sub
Sub ynsave()
Response = MsgBox("是否保存當前文件?", 5 + 43)
End Sub
Sub test()
ReDim lprasconn95(intArraySize) As RASCONN95
lprasconn95(0).dwSize = 412
lpcb = 256 * lprasconn95(0).dwSize
lngRetCode = RasEnumConnections(lprasconn95(0), lpcb, lpcConnections)
If lpcConnections = 0 Then
MsgBox "沒有撥號網絡連接!", vbInformation
Text1(0).Text = Text1(0).Text + "發送錯誤:沒有撥號網絡連接" + vbCrLf
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -