Уважаемые форумчане, в очередной раз прошу о помощи.
Написал макрос, который отправляет файлы по почте . Но почему то он работает не совсем корректно. Макрос создает и сохраняет нужный файл с нужным названием, но когда доходит дело к отправке возникают нюансы. При отправка файла по почте через CDO получатель получает файл с измененным именем, внутри имени добавляется символ t. Он появляется если имя файла больше 40 символов(по моим наблюдениям). Может кто то сталкивался с похожей проблемой. Бывает и так что символ t добавляется в расширение файла =(. Работаю в Терминале. адрывалрвыларывдлпрлвыоапловпловаплыовоап.xlsb - отправляю адрывалрвыларывдлпрлвыоапловпловаплыовоаtп.xlsb - получаю Ниже часть кода отвечающих за отправку письма:
[vba]
Код
Function SendMail(ByVal sTo As String, ByVal sSubject As String, ByVal FileNameXls As String) ' ' отправка письма ' Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/" Dim oCDOCnf As Object, oCDOMsg As Object, sMsg As String, sBody As String On Error Resume Next
If Len(SMTPserver) = 0 Then MsgBox "Не указан SMTP сервер", vbInformation: Exit Function If Len(sUsername) = 0 Then MsgBox "Не указана учетная запись", vbInformation: Exit Function If Len(sPass) = 0 Then MsgBox "Не указан пароль", vbInformation: Exit Function
'sBody = "Добрый день" 'Текст письма 'Проверка наличия файла по указанному пути If Dir(FileNameXls, vbDirectory) = "" Then FileNameXls = "" 'Назначаем конфигурацию CDO Set oCDOCnf = CreateObject("CDO.Configuration") With oCDOCnf.Fields .Item(CDO_Cnf & "sendusing") = 2 .Item(CDO_Cnf & "smtpauthenticate") = 1 .Item(CDO_Cnf & "smtpserver") = SMTPserver .Item(CDO_Cnf & "sendusername") = sUsername .Item(CDO_Cnf & "sendpassword") = sPass .Update End With 'Создаем сообщение Set oCDOMsg = CreateObject("CDO.Message") With oCDOMsg Set .Configuration = oCDOCnf .BodyPart.Charset = "UTF-8" .From = sFrom .To = sTo .BCC = scopy .Subject = sSubject .TextBody = sBody .AddAttachment FileNameXls .Send End With
Select Case Err.Number Case -2147220973: MsgBox "Нет доступа к Интернет _ " & sSubject Case -2147220975: MsgBox "Отказ сервера SMTP _ " & sSubject Case 0: Case Else: sMsg = "Ошибка номер: " & Err.Number & vbNewLine & "Описание ошибки: " & Err.Description: MsgBox sMsg & sSubject End Select Set oCDOMsg = Nothing: Set oCDOCnf = Nothing End Function
[/vba]
Спасибо.
Уважаемые форумчане, в очередной раз прошу о помощи.
Написал макрос, который отправляет файлы по почте . Но почему то он работает не совсем корректно. Макрос создает и сохраняет нужный файл с нужным названием, но когда доходит дело к отправке возникают нюансы. При отправка файла по почте через CDO получатель получает файл с измененным именем, внутри имени добавляется символ t. Он появляется если имя файла больше 40 символов(по моим наблюдениям). Может кто то сталкивался с похожей проблемой. Бывает и так что символ t добавляется в расширение файла =(. Работаю в Терминале. адрывалрвыларывдлпрлвыоапловпловаплыовоап.xlsb - отправляю адрывалрвыларывдлпрлвыоапловпловаплыовоаtп.xlsb - получаю Ниже часть кода отвечающих за отправку письма:
[vba]
Код
Function SendMail(ByVal sTo As String, ByVal sSubject As String, ByVal FileNameXls As String) ' ' отправка письма ' Const CDO_Cnf = "http://schemas.microsoft.com/cdo/configuration/" Dim oCDOCnf As Object, oCDOMsg As Object, sMsg As String, sBody As String On Error Resume Next
If Len(SMTPserver) = 0 Then MsgBox "Не указан SMTP сервер", vbInformation: Exit Function If Len(sUsername) = 0 Then MsgBox "Не указана учетная запись", vbInformation: Exit Function If Len(sPass) = 0 Then MsgBox "Не указан пароль", vbInformation: Exit Function
'sBody = "Добрый день" 'Текст письма 'Проверка наличия файла по указанному пути If Dir(FileNameXls, vbDirectory) = "" Then FileNameXls = "" 'Назначаем конфигурацию CDO Set oCDOCnf = CreateObject("CDO.Configuration") With oCDOCnf.Fields .Item(CDO_Cnf & "sendusing") = 2 .Item(CDO_Cnf & "smtpauthenticate") = 1 .Item(CDO_Cnf & "smtpserver") = SMTPserver .Item(CDO_Cnf & "sendusername") = sUsername .Item(CDO_Cnf & "sendpassword") = sPass .Update End With 'Создаем сообщение Set oCDOMsg = CreateObject("CDO.Message") With oCDOMsg Set .Configuration = oCDOCnf .BodyPart.Charset = "UTF-8" .From = sFrom .To = sTo .BCC = scopy .Subject = sSubject .TextBody = sBody .AddAttachment FileNameXls .Send End With
Select Case Err.Number Case -2147220973: MsgBox "Нет доступа к Интернет _ " & sSubject Case -2147220975: MsgBox "Отказ сервера SMTP _ " & sSubject Case 0: Case Else: sMsg = "Ошибка номер: " & Err.Number & vbNewLine & "Описание ошибки: " & Err.Description: MsgBox sMsg & sSubject End Select Set oCDOMsg = Nothing: Set oCDOCnf = Nothing End Function