В Экселе как открыть вложенный файл в письме через Аутлук? - VB

Узнай цену своей работы

Формулировка задачи:

Приветствую милые Дамы и уважаемые Господа!
У меня есть цель: С 3 магазинов в маем городе каждый вечер мне отправляют имаил с отчетом о прадажах. Уж очень хочется это дело автоматизировать. В магазинах я сделал им маленькую прогу для отправки письма, продавец в конце дня нажимает на кнопочку "отправить имайл" в Экселе
и данные отправляются, используя Аутлук, причем:1) тема письма это названия файла + дата, 2)боди - это название листа в книге и 3)создается новый файл, туда копируются данные сохраняются и закрываутся а затем этот файл прикрепляется к отправленному письму. Файл отправлен на почту который указан на листе "настройки". Работа сделанна на 5+ но вот небальшое затруднение при приеме данных. В Офисе куда кажды вечер стикаются данные, настроил Аутлук так что именно письма с магазинов скидываются в отдельную папку.
Цель состоит в следующем я открываю документ в Екселе, и нажимаю на кнопку, и макрос открывает полученные файлы и копирует их в мой документ. Помогите создать макрос который
справится с это задачей.
За ранее благодарю.
С Уважением Мердан

Решение задачи: «В Экселе как открыть вложенный файл в письме через Аутлук?»

textual
Листинг программы 
<font color="blue">Option</font> <font color="blue">Explicit</font>

<font color="#00AA00">'---------------------------------------------------------------------------------------</font>
<font color="#00AA00">' Procedure : Save_File</font>
<font color="#00AA00">' Purpose   : Ïðîöåäóðà ñîõðàíåíèÿ ôàéëà</font>
<font color="#00AA00">'---------------------------------------------------------------------------------------</font>
<font color="#00AA00">'Sub Save_File()</font>
<font color="#00AA00">'Dim ActiveSht As Worksheet</font>
<font color="#00AA00">'Dim NewWb As Workbook</font>
<font color="#00AA00">'</font>
<font color="#00AA00">'    Set ActiveSht = ActiveSheet</font>
<font color="#00AA00">'    Set NewWb = Workbooks.Add</font>
<font color="#00AA00">'    ActiveSht.Copy Before:=Workbooks(NewWb.Name).Sheets(1)</font>
<font color="#00AA00">'    With ActiveSheet.UsedRange</font>
<font color="#00AA00">'        .Value = .Value</font>
<font color="#00AA00">'    End With</font>
<font color="#00AA00">'    ActiveWorkbook.SaveAs Filename:=[Q5]</font>
<font color="#00AA00">'    MsgBox <font color="teal">"Ôîðìà ñêîïèðîâàíà è ñîõðàíåíà"</font>, , <font color="teal">""</font></font>
<font color="#00AA00">'End Sub</font>

<font color="blue">Sub</font> Save_File()
    <font color="blue">Dim</font> WorkDir, WorkDate
    <font color="blue">Dim</font> WorkFile <font color="blue">As</font> <font color="blue">String</font>
    WorkDir = [Q4]
    WorkFile = [Q5]
    Columns(<font color="teal">"A:O"</font>).<font color="blue">Select</font>
    Range(<font color="teal">"A3"</font>).Activate
    Selection.Copy
    Workbooks.Add
    Columns(<font color="teal">"A:A"</font>).<font color="blue">Select</font>
    Range(<font color="teal">"A1"</font>).<font color="blue">Select</font>
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Sheets(<font color="teal">"Sheet2"</font>).<font color="blue">Select</font>
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.Delete
    Sheets(<font color="teal">"Sheet3"</font>).<font color="blue">Select</font>
    ActiveWindow.SelectedSheets.Delete
    Sheets(<font color="teal">"Sheet1"</font>).<font color="blue">Select</font>
    Sheets(<font color="teal">"Sheet1"</font>).<font color="blue">Name</font> = [E2]
    Cells.<font color="blue">Select</font>
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = <font color="darkblue"><b>0</b></font>
    Range(<font color="teal">"I7"</font>).<font color="blue">Select</font>
<font color="#00AA00">'    ChDir = WorkDir</font>
    ActiveWorkbook.SaveAs Filename:=WorkFile, _
    FileFormat:=xlNormal, _
    Password:=<font color="teal">""</font>, _
    WriteResPassword:=<font color="teal">""</font>, _
    ReadOnlyRecommended:=False, _
    CreateBackup:=False
    ActiveWindow.<font color="blue">Close</font>
    MsgBox <font color="teal">"Ôàéë îò÷åòà ñîõðàíåí!"</font>, , <font color="teal">"Îïåðàöèÿ çàâåðøåíà"</font>
    Range(<font color="teal">"A1:M1"</font>).<font color="blue">Select</font>
<font color="blue">End</font> <font color="blue">Sub</font>

<font color="#00AA00">'---------------------------------------------------------------------------------------</font>
<font color="#00AA00">' Procedure : Send_Mail</font>
<font color="#00AA00">' Purpose   : Ïðîöåäóðà îòïðàâêè ïèñüìà</font>
<font color="#00AA00">'---------------------------------------------------------------------------------------</font>
<font color="blue">Sub</font> Send_Mail()
    <font color="blue">Const</font> CDO_Cnf = <font color="teal">"http://schemas.microsoft.com/cdo/configuration/"</font>
    <font color="blue">Dim</font> oCDOCnf <font color="blue">As</font> <font color="blue">Object</font>, oCDOMsg <font color="blue">As</font> <font color="blue">Object</font>
    <font color="blue">Dim</font> SMTPserver <font color="blue">As</font> <font color="blue">String</font>, sUsername <font color="blue">As</font> <font color="blue">String</font>, sPass <font color="blue">As</font> <font color="blue">String</font>, sMsg <font color="blue">As</font> <font color="blue">String</font>
    <font color="blue">Dim</font> sTo <font color="blue">As</font> <font color="blue">String</font>, sFrom <font color="blue">As</font> <font color="blue">String</font>, sSubject <font color="blue">As</font> <font color="blue">String</font>, sBody <font color="blue">As</font> <font color="blue">String</font>, sAttachment <font color="blue">As</font> <font color="blue">String</font>
    <font color="blue">On</font> <font color="blue">Error</font> <font color="blue">Resume</font> <font color="blue">Next</font>
    <font color="#00AA00">'sFrom - êàê ïðàâèëî ñîâïàäàåò ñ sUsername</font>
    SMTPserver = [Q10]    <font color="#00AA00">' SMTPServer: íàéòè ïîäõîäÿùèé ñåðâåð</font>
    sUsername = [Q11]   <font color="#00AA00">' Ó÷åòíàÿ çàïèñü íà ñåðâåðå</font>
    sPass = [Q12]    <font color="#00AA00">' Ïàðîëü ê ïî÷òîâîìó àêêàóíòó</font>

    <font color="blue">If</font> Len(SMTPserver) = <font color="darkblue"><b>0</b></font> <font color="blue">Then</font> MsgBox <font color="teal">"Íå óêàçàí SMTP ñåðâåð"</font>, vbInformation, <font color="teal">"Îøèáêà"</font>: <font color="blue">Exit</font> <font color="blue">Sub</font>
    <font color="blue">If</font> Len(sUsername) = <font color="darkblue"><b>0</b></font> <font color="blue">Then</font> MsgBox <font color="teal">"Íå óêàçàíà ó÷åòíàÿ çàïèñü"</font>, vbInformation, <font color="teal">"Îøèáêà"</font>: <font color="blue">Exit</font> <font color="blue">Sub</font>
    <font color="blue">If</font> Len(sPass) = <font color="darkblue"><b>0</b></font> <font color="blue">Then</font> MsgBox <font color="teal">"Íå óêàçàí ïàðîëü"</font>, vbInformation, <font color="teal">"Îøèáêà"</font>: <font color="blue">Exit</font> <font color="blue">Sub</font>

    sTo = [Q8]    <font color="#00AA00">'Êîìó</font>
    sFrom = [Q9]    <font color="#00AA00">'Îò êîãî</font>
    sSubject = [A1]    <font color="#00AA00">'Òåìà ïèñüìà</font>
    sBody = [Q3]    <font color="#00AA00">'Òåêñò ïèñüìà</font>
    sAttachment = [Q5]    <font color="#00AA00">'Âëîæåíèå(ïîëíûé ïóòü ê ôàéëó)</font>
    <font color="#00AA00">'Ïðîâåðêà íàëè÷èÿ ôàéëà ïî óêàçàííîìó ïóòè</font>
    <font color="blue">If</font> Dir(sAttachment, vbDirectory) = <font color="teal">""</font> <font color="blue">Then</font> sAttachment = <font color="teal">""</font>
    <font color="#00AA00">'Íàçíà÷àåì êîíôèãóðàöèþ CDO</font>
    <font color="blue">Set</font> oCDOCnf = CreateObject(<font color="teal">"CDO.Configuration"</font>)
    <font color="blue">With</font> oCDOCnf.Fields
        .Item(CDO_Cnf & <font color="teal">"sendusing"</font>) = <font color="darkblue"><b>2</b></font>
        .Item(CDO_Cnf & <font color="teal">"smtpauthenticate"</font>) = <font color="darkblue"><b>1</b></font>
        .Item(CDO_Cnf & <font color="teal">"smtpserver"</font>) = SMTPserver
        .Item(CDO_Cnf & <font color="teal">"smtpserverport"</font>) = <font color="darkblue"><b>465</b></font>
        .Item(CDO_Cnf & <font color="teal">"smtpusessl"</font>) = <font color="darkblue"><b>1</b></font>
        .Item(CDO_Cnf & <font color="teal">"sendusername"</font>) = sUsername
        .Item(CDO_Cnf & <font color="teal">"sendpassword"</font>) = sPass
        .Update
    <font color="blue">End</font> <font color="blue">With</font>
    <font color="#00AA00">'Ñîçäàåì ñîîáùåíèå</font>
    <font color="blue">Set</font> oCDOMsg = CreateObject(<font color="teal">"CDO.Message"</font>)
    <font color="blue">With</font> oCDOMsg
        <font color="blue">Set</font> .Configuration = oCDOCnf
        .BodyPart.Charset = <font color="teal">"koi8-r"</font>
        .From = sFrom
        .<font color="blue">To</font> = sTo
        .Subject = sSubject
        .TextBody = sBody
        <font color="blue">If</font> Len(sAttachment) > <font color="darkblue"><b>0</b></font> <font color="blue">Then</font> .AddAttachment sAttachment
        .Send
    <font color="blue">End</font> <font color="blue">With</font>

    <font color="blue">Select</font> <font color="blue">Case</font> Err.Number
    <font color="blue">Case</font> -<font color="darkblue"><b>2147220973</b></font>: sMsg = <font color="teal">"Íåò äîñòóïà ê Èíòåðíåò"</font>
    <font color="blue">Case</font> -<font color="darkblue"><b>2147220975</b></font>: sMsg = <font color="teal">"Îòêàç ñåðâåðà SMTP"</font>
    <font color="blue">Case</font> <font color="darkblue"><b>0</b></font>: sMsg = <font color="teal">"Îò÷åò îòïðàâëåí!"</font>
    <font color="blue">End</font> <font color="blue">Select</font>
    MsgBox sMsg, vbInformation, <font color="teal">"Îòïðàâêà ñîîáùåíèÿ"</font>
    <font color="blue">Set</font> oCDOMsg = <font color="blue">Nothing</font>: <font color="blue">Set</font> oCDOCnf = <font color="blue">Nothing</font>
<font color="blue">End</font> <font color="blue">Sub</font>

<font color="#00AA00">'---------------------------------------------------------------------------------------</font>
<font color="#00AA00">' Procedure : Get_File_Path</font>
<font color="#00AA00">' Purpose   : Ïðîöåäóðà âûáîðà ôàéëà</font>
<font color="#00AA00">'---------------------------------------------------------------------------------------</font>
<font color="#00AA00">'Sub Get_File_Path()</font>
<font color="#00AA00">'    Dim sPath</font>
<font color="#00AA00">'    sPath = Application.GetOpenFilename(<font color="teal">"All Files(*.*),*.*"</font>, , <font color="teal">"Âûáðàòü ôàéëû"</font>, <font color="teal">"Âûáðàòü"</font>, False)</font>
<font color="#00AA00">'    If sPath = False Then Exit Sub</font>
<font color="#00AA00">'    [Q5] = sPath</font>
<font color="#00AA00">'End Sub</font>

ИИ для рефератов и докладов

  • Экспорт Word по ГОСТу
  • Минимум 80% уникальности текста
  • Поиск релевантных источников в интернете
  • Готовый документ за 2 минуты

Оцени полезность:

5   голосов , оценка 4.2 из 5
Похожие ответы