Страницы: 1
RSS
Ошибка при формировании письма в Lotus из Excel
 
Добрый день!  
Прошу помощи.  
 
При формировании письма в 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
 
Пишу "периодически", т.к. данная ошибка возникает когда начинаю менять корневую папку своего файла.  
 
Т.е. если я буду запускать свой файл Excel с данным макросом из папки C:\Documents and Settings\admin\Мои документы\Мои рисунки\ то проблем не возникает.  
Если же файл Excel с данным макросом я стартую из папки C:\Documents and Settings\admin\Мои документы\ПростоПапка\ то возникает описанная выше ошибка.
 
Методом "проб и ошибок" выяснил, раз возникнув, данная ошибка уже начинает повторятся вне зависимости от последующей корневой папки файла. Чтобы вернуть файл к "рабочему" состоянию:  
 
1. Перемещаю файл Excel, например, на рабочий стол  
2. Комментирую строку  
'Set uiDoc = uiWorkspace.EDITDOCUMENT(True, MailDoc)  
3. Запускаю макрос  
4. Снимаю комментирование с строки  
Set uiDoc = uiWorkspace.EDITDOCUMENT(True, MailDoc)  
5. Все снова начинает работать.  
 
Но вот причина данной ошибки так и остается не ясной.
 
Заменил строку  
Set uiDoc = uiWorkspace.EDITDOCUMENT(True, MailDoc)  
на  
Call uiWorkspace.EDITDOCUMENT(True, MailDoc)  
 
Проблема вроде исчезла. Только не уверен, правильно ли я сделал?
Страницы: 1
Читают тему
Loading...