使用不同的Outlook電子郵件地址從Access發送電子郵件

我試圖從Outlook使用與我的默認設置不同的Outlook地址發送傳真。以下是我的代碼。使用不同的Outlook電子郵件地址從Access發送電子郵件

謝謝。

私人小組FaxDoctor（）「傳真的醫生信對錯誤轉到Error_Handler 昏暗FSO

Dim olApp As Object 

' Dim olApp As Outlook.Application 

Dim olNS As Outlook.NameSpace 
Dim olfolder As Outlook.MAPIFolder 
Dim olMailItem As Outlook.MailItem 
Set fso = CreateObject("Scripting.FileSystemObject") 

If fso.FileExists("\\pna434h0360\PharmServ\Output\" & Me!ID & ".pdf") Then ' If the filename is found 
    Set olApp = CreateObject("Outlook.Application") 
    Set olNS = olApp.GetNamespace("MAPI") 
    Set olfolder = olNS.GetDefaultFolder(olFolderInbox) 
    Set olMailItem = olfolder.Items.Add("IPM.Note") 
    olMailItem.display 
    With olMailItem 
     .Subject = " " 
     .To = "[fax:" & "Dr. " & Me.[Prescriber First Name] & " " & Me.[Prescriber Last Name] & "@" & 1 & Me!Fax & "]" ' Must be formatted exactly to be sent as a fax 
     '.Body = "This is the body text for the fax cover page" ' Inserts the body text 
     .Attachments.Add "\\pna434h0360\PharmServ\Output\" & Me!ID & ".pdf" ' attaches the letter to the e-mail/fax 
     '.SendUsingAccount = olNS.Accounts.Item(2) 'Try this to change email accounts 
    End With 

    Set olMailItem = Nothing 
    Set olfolder = Nothing 
    Set olNS = Nothing 
    Set olApp = Nothing 
Else 
    GoTo Error_Handler 
End If

Exit_Procedure：上的錯誤繼續下一步退出小組 Error_Handler： MSGBOX（」無字母找到「& vbCrLf &」如果您確定這封信是以正確的文件名保存的，請關閉Outlook並再試一次。「）」這經常崩潰，因爲沒有找到該信件或因爲outlook崩潰。在這種情況下，應關閉每個Outlook進程並重新啓動Outlook。 Exit Sub End Sub

來源

2016-02-11 The_Capatin

您可以使用郵件項目的'SendUsingAccount'屬性更改Outlook帳戶。這需要設置爲一個帳戶對象。

您可以使用類似這樣的方式設置給定名稱的帳戶，其中'AccountName'是您要發送的地址。

Dim olAcc as Outlook.Account 

For Each olAcc In Outlook.Session.Accounts 
    If outAcc.UserName = 'AccountName' Then 
     olMailItem.SendUsingAccount = outAcc 
     Exit For 
    End If 
Next

來源

2016-02-11 15:00:37 jhTuppeny

使用「.SendOnBehalfOfName」

我發現這個功能上線，所以只要按照其領先地位嘗試：

Function SendEmail() 

Dim Application As Outlook.Application 
Dim NameSpace As Outlook.NameSpace 

Dim SafeItem, oItem ' Redemption 

Set Application = CreateObject("Outlook.Application") 

Set NameSpace = Application.GetNamespace("MAPI") 

NameSpace.Logon 


Set SafeItem = CreateObject("Redemption.SafeMailItem") 'Create an instance of Redemption.SafeMailItem 
Set oItem = Application.CreateItem(0) 'Create a new message 
SafeItem.Item = oItem 'set Item property 
SafeItem.Recipients.Add "[email protected]" 
SafeItem.Recipients.ResolveAll 
SafeItem.Subject = "Testing Redemption" 
SafeItem.SendOnBehalfOfName = "[email protected]" 

SafeItem.Send 

End Function

來源

2016-02-11 16:14:04

使用不同的Outlook電子郵件地址從Access發送電子郵件

回答

相關問題