Добрый день!
Прошу помощи.
При формировании письма в Lotus из Excel периодически выскакивает ошибка:
Run-time error '-2147417851 (80010105)': Automation error
VBA ругается на строку:
Set uiDoc = uiWorkspace.EDITDOCUMENT(True, MailDoc)
В чем может быть проблема?
Код макроса прилагаю.
==========================
Sub Макрос_ОтправкаПисьма()
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'The current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim Subject As String 'The subject string
Dim Attachment As String 'The path to the attachemnt string
Dim Recipient As String 'The Recipient string (or you could use the list)
Dim Recip(10) As Variant 'The Recipient list
Dim BodyText As String 'The body text
Dim SaveIt As Boolean 'Save to sent mail
Dim WasOpen As Integer 'Checking to see if the Mail DB was already
Dim uiDoc As Object
Dim uiWorkspace As Object
Dim docProfile As Variant
Dim strProfileEnableSignature As Variant
Dim CopyTo As String
Dim BlindCopyTo As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Subject = ТемаПисьма
Recipient = Email_Кому
CopyTo = Email_Копия
BlindCopyTo = Email_СкрытаяКопия
SaveIt = True
Set Session = CreateObject("Notes.NotesSession")
Set uiWorkspace = CreateObject("Notes.NotesUIWorkspace")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
WasOpen = 1 'Already open for mail
Else
WasOpen = 0
Maildb.OPENMAIL 'This will prompt you for password
End If
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = Recipient 'Or use Racip(10) for multiple
MailDoc.CopyTo = CopyTo
MailDoc.BlindCopyTo = BlindCopyTo
MailDoc.Subject = Subject
MailDoc.Body = ТекстПисьма
'MailDoc.SAVEMESSAGEONDRAFTS = SaveIt
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", ВложениеПисьма)
'MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
'Set uiDoc = uiWorkspace.EDITDOCUMENT(True, MailDoc)
Set docProfile = Maildb.GETPROFILEDOCUMENT("CalendarProfile")
strProfileEnableSignature = docProfile.GETITEMVALUE("EnableSignature")(0)
If strProfileEnableSignature = "1" Then
docProfile.EnableSignature = ""
Call docProfile.Save(True, False)
End If
Set uiDoc = uiWorkspace.EDITDOCUMENT(True, MailDoc)
If strProfileEnableSignature = "1" Then
docProfile.EnableSignature = "1"
Call docProfile.Save(True, False)
End If
'MailDoc.SEND 0, Recipient // if you want to send
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set EmbedObj = Nothing
Set uiDoc = Nothing
If WasOpen = 1 Then
Set Session = Nothing
ElseIf WasOpen = 0 Then
Set Session = Nothing
End If
Dim Msg, Style, Title
'Msg = "E-mail has been sent to " & Recipient & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Press OK to continue."
Style = vbOKOnly + vbInformation
Title = "Open Issues List"
'Response = MsgBox(Msg, Style, Title, Help, Ctxt)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Прошу помощи.
При формировании письма в Lotus из Excel периодически выскакивает ошибка:
Run-time error '-2147417851 (80010105)': Automation error
VBA ругается на строку:
Set uiDoc = uiWorkspace.EDITDOCUMENT(True, MailDoc)
В чем может быть проблема?
Код макроса прилагаю.
==========================
Sub Макрос_ОтправкаПисьма()
Dim Maildb As Object 'The mail database
Dim UserName As String 'The current users notes name
Dim MailDbName As String 'The current users notes mail database name
Dim MailDoc As Object 'The mail document itself
Dim AttachME As Object 'The attachment richtextfile object
Dim Session As Object 'The notes session
Dim EmbedObj As Object 'The embedded object (Attachment)
Dim Subject As String 'The subject string
Dim Attachment As String 'The path to the attachemnt string
Dim Recipient As String 'The Recipient string (or you could use the list)
Dim Recip(10) As Variant 'The Recipient list
Dim BodyText As String 'The body text
Dim SaveIt As Boolean 'Save to sent mail
Dim WasOpen As Integer 'Checking to see if the Mail DB was already
Dim uiDoc As Object
Dim uiWorkspace As Object
Dim docProfile As Variant
Dim strProfileEnableSignature As Variant
Dim CopyTo As String
Dim BlindCopyTo As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Subject = ТемаПисьма
Recipient = Email_Кому
CopyTo = Email_Копия
BlindCopyTo = Email_СкрытаяКопия
SaveIt = True
Set Session = CreateObject("Notes.NotesSession")
Set uiWorkspace = CreateObject("Notes.NotesUIWorkspace")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
WasOpen = 1 'Already open for mail
Else
WasOpen = 0
Maildb.OPENMAIL 'This will prompt you for password
End If
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
MailDoc.sendto = Recipient 'Or use Racip(10) for multiple
MailDoc.CopyTo = CopyTo
MailDoc.BlindCopyTo = BlindCopyTo
MailDoc.Subject = Subject
MailDoc.Body = ТекстПисьма
'MailDoc.SAVEMESSAGEONDRAFTS = SaveIt
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", ВложениеПисьма)
'MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
'Set uiDoc = uiWorkspace.EDITDOCUMENT(True, MailDoc)
Set docProfile = Maildb.GETPROFILEDOCUMENT("CalendarProfile")
strProfileEnableSignature = docProfile.GETITEMVALUE("EnableSignature")(0)
If strProfileEnableSignature = "1" Then
docProfile.EnableSignature = ""
Call docProfile.Save(True, False)
End If
Set uiDoc = uiWorkspace.EDITDOCUMENT(True, MailDoc)
If strProfileEnableSignature = "1" Then
docProfile.EnableSignature = "1"
Call docProfile.Save(True, False)
End If
'MailDoc.SEND 0, Recipient // if you want to send
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set EmbedObj = Nothing
Set uiDoc = Nothing
If WasOpen = 1 Then
Set Session = Nothing
ElseIf WasOpen = 0 Then
Set Session = Nothing
End If
Dim Msg, Style, Title
'Msg = "E-mail has been sent to " & Recipient & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Press OK to continue."
Style = vbOKOnly + vbInformation
Title = "Open Issues List"
'Response = MsgBox(Msg, Style, Title, Help, Ctxt)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub