----------------------------------------------------------
前兩天剛剛看過壹個不需要outlook發郵件的方法，轉貼在下面；
我用access試過是可以的，excel中應該也沒有問題，哪位高人給大家做個例子？
:handshake
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub 發送_Click()
On Error GoTo Err1
If Len(Nz(Me.發件人用戶名)) = 0 Or Len(Nz(Me.發送郵箱)) = 0 Or Len(Nz(Me.發件人密碼)) = 0 _
Or Len(Nz(Me.收件人用戶名)) = 0 Or Len(Nz(Me.接收郵箱)) = 0 Or Len(Nz(Me.主題)) = 0 Then
MsgBox "輸入信息不完全!" & Chr(13) & Chr(13) & _
"發件人用戶名、郵箱、密碼，收件人用戶名、郵箱，主題等均要輸入。", vbInformation, "提示"
Exit Sub
End If
Dim stUl As String '微軟服務器網址
Dim vCDO As Variant 'CDO.Message對象
Dim stUs As String '發送方郵箱名稱
Dim stRx As String '發送方郵箱服務器
Dim stPw As String '發送方郵箱密碼
Dim stE1 As String '主要接收方郵箱完整帳號
Dim stE2 As String '備用接收方郵箱完整帳號
Dim stZt As String '郵件主題
Dim stNr As String '郵件內容
Dim stFj As String '郵件附件
stUs = Trim(Me.發件人用戶名)
stRx = Trim(Me.發送郵箱)
stPw = Trim(Me.發件人密碼)
stE1 = Trim(Me.收件人用戶名) & "@" & Trim(Me.接收郵箱)
stZt = Trim(Me.主題)
stNr = Trim(Nz(Me.內容))
stFj = Trim(Nz(Me.附件))
stUl = "/cdo/configuration/" '微軟服務器網址
DoCmd.Hourglass True
Me.Label21.Visible = True
Set vCDO = CreateObject("CDO.Message") '建立對象
vCDO.From = stUs & "@" & stRx '發送方郵箱完整帳號
vCDO.To = stE1 '主要接收方郵箱完整帳號
If Len(stE2) > 0 Then vCDO.CC = stE2 '備用接收方郵箱完整帳號
vCDO.SubJect = stZt '郵件主題
vCDO.Textbody = stNr '郵件內容
If Len(stFj) > 0 Then vCDO.AddAttachment stFj '郵件附件
With vCDO.Configuration.Fields
.Item(stUl & "smtpserver") = "smtp." & stRx 'SMTP服務器地址
.Item(stUl & "smtpserverport") = 25 'SMTP服務器端口
.Item(stUl & "sendusing") = 2 '發送端口
.Item(stUl & "smtpauthenticate") = 1 '
.Item(stUl & "sendusername") = stUs '發送方郵箱名稱
.Item(stUl & "sendpassword") = stPw '發送方郵箱密碼
.Update
End With
vCDO.Send '發送
Set vCDO = Nothing
MsgBox "發送成功！", vbInformation, "提示"
Exit1:
Me.Label21.Visible = False
DoCmd.Hourglass False
Exit Sub
Err1:
MsgBox Err.Description, vbExclamation, "錯誤提示"
Resume Exit1
End Sub
Private Sub 關閉_Click()
DoCmd.Close
End Sub
Private Sub 選擇附件_Click()
Dim dlgOpen ' As FileDialog
Set dlgOpen = FileDialog(1)
With dlgOpen
.Show
.AllowMultiSelect = False
If .SelectedItems.Count > 0 Then Me.附件 = .SelectedItems(1)
End With
End Sub