我正在尝试使用与我的地址不同的Outlook地址从Outlook发送传真,这是它默认的地址。 下面是我的代码。
谢谢。
私人子传真医生() ' 传真医生与信件出错时转到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("\pna434h0360PharmServOutput" & 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 "\pna434h0360PharmServOutput" & 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。 退出子结束子
您可以使用邮件项目的"发送使用帐户"属性更改 Outlook 帐户。这需要设置为帐户对象。
您可以使用类似以下内容为给定名称设置帐户,其中"帐户名"是您发送的地址。
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
尝试使用 ".代表姓名发送"
我在网上找到了这个功能,所以只需遵循它的领导:
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 "customer@ispprovider.com"
SafeItem.Recipients.ResolveAll
SafeItem.Subject = "Testing Redemption"
SafeItem.SendOnBehalfOfName = "Invoices@companyname.com"
SafeItem.Send
End Function