Need help to amend the current code for Zimbra application
Results 1 to 2 of 2

Thread: Need help to amend the current code for Zimbra application

  1. #1
    Junior Member
    Join Date
    Apr 2015

    Post Need help to amend the current code for Zimbra application

    Hi Experts,

    The below VBA code helps me to send multiple mail in excel via outlook application. Is it possible to use the same code to send multiple mails via Zimbra Application.

    Option Explicit
    Sub Preview()
        Call SetRange
        SendEmail False
        Exit Sub
    End Sub
    Sub NoPreview()
        Call SetRange
        SendEmail True
        Exit Sub
    End Sub
    Sub SendEmail(Optional bNoPreview As Boolean)
    Dim iRec As Long
    Dim OutApp As Object
    Dim OutMail As Object
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim wdRng As Object
    Dim rng As Range
    Dim StrBody As String
    Dim StrBody1 As String
    Dim i As Long
    Dim Subj As String
    Dim FilePath As String
    Dim EmailTo As String
    Dim CCto As String
        With Range("MergeData")
            For i = 2 To .Rows.Count
                Range("MergeRecord") = i - 1
                Set rng = Nothing
                Subj = .Cells(i, "A").Value & " - " & .Cells(i, "D").Value & " - " & .Cells(i, "N")
                FilePath = .Cells(i, "I").Value & .Cells(i, "A").Value & ".pdf"
                EmailTo = .Cells(i, "H").Value
                'CCto = .Cells(i, "D").Value
               Application.DisplayAlerts = False
                Set rng = Sheets("Sheet2").Range("A1:E2").SpecialCells(xlCellTypeVisible)
                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)
                StrBody = "Dear Sir," & vbCr & vbCr & _
                          "We have the outstanding in our system. Could you please provide your agreement on it." & vbCr & vbCr
                StrBody1 = vbCr & "If you have any queries in regards to the above, please do not hesitate to contact me." & vbCr & vbCr & _
                          "Look forward for your reply." & vbCr & vbCr & "Many thanks in advance." & vbCr
                On Error Resume Next
                With OutMail
                    .To = EmailTo
                    .CC = CCto
                    .BCC = ""
                    .Subject = Subj
                    .BodyFormat = 2
                    Set olInsp = .GetInspector
                    Set wdDoc = olInsp.WordEditor
                    Set wdRng = wdDoc.Range(0, 0)
                    wdRng.Text = StrBody
                    wdRng.collapse 0
                    wdRng.collapse 0
                    wdRng.Text = StrBody1
                If FileExists(FilePath) Then
                  .Attachments.Add FilePath
                  MsgBox "The file " & FilePath & " does not exist at that location."
                End If
                If bNoPreview Then
                End If
                End With
                On Error GoTo 0
                With Application
                    .EnableEvents = True
                    .ScreenUpdating = True
                End With
                Set OutMail = Nothing
                Set OutApp = Nothing
                Application.DisplayAlerts = True
                'Sheets("RAW_Data").Cells(1, "A").Value = "Outlook sent Time, Dynamic msg preview  count  = " & i
               Next i
        End With
        Set OutApp = Nothing
        Set OutMail = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set wdRng = Nothing
        Set rng = Nothing
        Exit Sub
    End Sub
    Sub SetRange()
    Dim xlSheet As Worksheet
    Dim LastRow As Long, LastCol As Long
    Dim rng As Range
        Set xlSheet = Sheets("RAW_Data")
        With xlSheet
            LastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            Application.Calculation = xlManual
            Names.Add Name:="MergeData", _
                      RefersToR1C1:="=RAW_Data!R1C1:R" & LastRow & "C" & LastCol
            Application.Calculation = xlAutomatic
        End With
          Set xlSheet = Nothing
    End Sub
    Public Function FileExists(ByVal Filename As String) As Boolean
    Dim lngAttr As Long
        On Error GoTo NoFile
        lngAttr = GetAttr(Filename)
        If (lngAttr And vbDirectory) <> vbDirectory Then
            FileExists = True
        End If
        Exit Function
    End Function

  2. #2
    ZeXtras Community Manager ZeXtras Employee Cine's Avatar
    Join Date
    Apr 2011
    Hello Jagdev,
    welcome to the forums!

    Foreword: I'm by no means a VBA expert and it's been a long time since I last used it
    While I don't think it's possible to actively interact with the WebClient (at least with VBA), it might be possible to send emails via SMTP using CDO...

    I'll move this thread over to the "Zimbra HowTo" section, if anyone has any more info about this topic please feel free to contribute!

    Have a nice day,
    the ZeXtras Team


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts