VBA ва Outlookни интеграциялаш. Интеграция с Outlook

            Биламизки, Excelда хисоботлар, хужжатчиликни автоматилаштириш мумкин. Лекин, уни e-mail оркали жунатиб туриш керак булсачи? Ва бу хатлар доим бир хил шаблонга эга булса (масалан, хужжат мавзуси, адресатлар – «Кому», «Копия» пунктидаги, хат матнининг диапазани), ва компьютерда MS Outlook кулланилаётган булса, бу ишни хам, макросларга (Visual Basic for Applications) га буюрса булар экан.

            Куйида бу коднинг мисолини куриб чикамиз:

           

Sub CreateEmailForSibur()

'Formulalarni qayta hisoblaymiz

Calculate

'xat yozilgan qismni belgilaymiz

Range("C5:d25").Select

    Dim rng As Range

    Dim OutApp As Object

    Dim OutMail As Object

    Set rng = Nothing

    On Error Resume Next

    'Only the visible cells in the selection

    Set rng = Selection.SpecialCells(xlCellTypeVisible)

    'You can also use a fixed range if you want

    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)

    On Error GoTo 0

    If rng Is Nothing Then

        MsgBox "The selection is not a range or the sheet is protected" & _

               vbNewLine & "please correct and try again.", vbOKOnly

        Exit Sub

    End If

    With Application

        .EnableEvents = False

        .ScreenUpdating = False

    End With

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    'Umrbek: shu yerga nimani qayerdan olishni yozamiz

    With OutMail

        .To = Range("J6")

        .CC = Range("J8")

        .BCC = ""

        .Subject = Range("C3")

         .HTMLBody = RangetoHTML(rng)

        'Umrbek: shu yerda RangetoHTML funksiyasiga boglanyapmiz, u bilan birgalikda ishlaydi bu kod

'        .Body = Selection.Paste

        .Display   'or use .Send

    End With

    On Error GoTo 0

    With Application

        .EnableEvents = True

        .ScreenUpdating = True

    End With

    Set OutMail = Nothing

    Set OutApp = Nothing

End Sub

Function RangetoHTML(rng As Range)

        'Umrbek: bu funksiya, yuqoridagi Sub (Protsedura shu funksiya bilan ishlaydi)

    Dim fso As Object

    Dim ts As Object

    Dim TempFile As String

    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in

    rng.Copy

    Set TempWB = Workbooks.Add(1)

    With TempWB.Sheets(1)

        .Cells(1).PasteSpecial Paste:=8

        .Cells(1).PasteSpecial xlPasteValues, , False, False

        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        .Cells(1).Select

        Application.CutCopyMode = False

        On Error Resume Next

        .DrawingObjects.Visible = True

        .DrawingObjects.Delete

        On Error GoTo 0

    End With

    'Publish the sheet to a htm file

    With TempWB.PublishObjects.Add( _

         SourceType:=xlSourceRange, _

         Filename:=TempFile, _

         Sheet:=TempWB.Sheets(1).Name, _

         Source:=TempWB.Sheets(1).UsedRange.Address, _

         HtmlType:=xlHtmlStatic)

        .Publish (True)

    End With

    'Read all data from the htm file into RangetoHTML

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

    RangetoHTML = ts.readall

    ts.Close

    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

                          "align=left x:publishsource=")

    'Close TempWB

    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function

    Kill TempFile

    Set ts = Nothing

    Set fso = Nothing

    Set TempWB = Nothing

End Function

Юкорида курсатилган функция ва процедура оркали e-mail юбориш учун етарли. Факат, изохларда айтиб утилгандек, кайси диапазондан нимани олиш кераклиги курсатилса етарли. Яъни адресатларни хам бирор катакка ёзиб куйсангиз узи керак еридан олиб жойига куяди. Яна масалан, мавзу (Тема) хам бирор формулалардан хисобланса, униям формула хисобланаётган катакдан олиб куяди. Масалан дейлик, теманинг формуласи: =СЦЕПИТЬ("Бажарилган ишлар тугрисида ";ТЕКСТ(СЕГОДНЯ();"ДД.ММ.ГГГГ");" й. кунига хисобот")

#MSOutlook #OutlookVBA #Outlook_VBA #Outlook_Excel #EmailAutomatization #Automatization #UzbekProgrammSites #OzbekTilida #OzbekTilidaDasturlar #OzbekTilidaDasturYozish #KompyuterSavodxonligi #Ma’lumotlarBazasi #IshYuritishniAvtomatlashtirish