-1

Hy everyone

I am working on email automation, I need to send a customized email for each member of my team. To do this I am using an excel sheet, coding with vba and using Lotus Notes to send my email.

I can send only 1 email each time I lunch the program but I need to send 900 or more.

I have an the following error '-2147417851 (80010105)': Automation Error .

Here is an the code :

     Sub Envoi_Email()
Dim range As range
Dim MailDoc As Object
Dim Notes As Object, db As Object, WorkSpace As Object
Dim UIdoc As Object, UserName As String, MailDbName As String
Dim Ligne As Long, CountRows As Long
Dim Var As Variant
Dim compteur_envoi As Long

compteur_envoi = 0
CountRows = Split(Worksheets("Courant").UsedRange.Address, "$")(4)



   Set Notes = CreateObject("Notes.NotesSession")
        UserName = Notes.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
        Set db = Notes.GetDataBase("", MailDbName)

        'wait function
        'Application.Wait (Now + TimeValue("0:00:10"))



For Ligne = 2 To CountRows

    If Left(Trim(Worksheets("Courant").Cells(Ligne, Column_Name("Industry*").Column)), 4) <> "BS01" And Left(Trim(Worksheets("Courant").Cells(Ligne, Column_Name("Industry*").Column)), 4) <> "BT01" And Left(Trim(Worksheets("Courant").Cells(Ligne, Column_Name("Industry*").Column)), 4) <> "BA03" And Left(Trim(Worksheets("Courant").Cells(Ligne, Column_Name("Industry*").Column)), 4) <> "BA04" And Left(Trim(Worksheets("Courant").Cells(Ligne, Column_Name("Industry*").Column)), 4) <> "BI01" And Left(Trim(Worksheets("Courant").Cells(Ligne, Column_Name("JOB*").Column)), 2) <> "LP" Then
  'Ouvrir la session


        Set WorkSpace = CreateObject("Notes.NotesUIWorkspace")
        Call WorkSpace.ComposeDocument(, , "Memo")
        Set UIdoc = WorkSpace.CURRENTDOCUMENT

        'wait function
        'Application.Wait (Now + TimeValue("0:00:10"))



        Var = Worksheets("Courant").Cells(Ligne, Column_Name("Mat*").Column)

        Call UIdoc.FieldSetText("EnterSendTo", Worksheets("Courant").Cells(Ligne, Column_Name("Email*").Column).Value) 'Recipient
        Call UIdoc.FieldSetText("Subject", "Congés au  " & Now)


      Worksheets("Courant").range("A1:" & Replace(Cells(1, Columns(Split(Worksheets("Courant").UsedRange.Address, "$")(3)).Column).Address(1, 5, 1), "$1", "") & CountRows).AutoFilter Field:=1, Criteria1:=Var, VisibleDropDown:=False
   'Worksheets("Courant").range("A1:AA22").AutoFilter Field:=1, Criteria1:=Var, VisibleDropDown:=False

        'Application.Wait (Now + TimeValue("0:00:10"))

                    Worksheets("Courant").range(Column_Name("CP2 *").Address & ":" & Left(Column_Name_Previous("SLD *").Address, Len(Column_Name_Previous("SLD *").Address) - 1) & CountRows).CopyPicture xlScreen, xlBitmap


        Call UIdoc.GotoField("Body")

        Call UIdoc.InsertText("Bonjour" & " " & Worksheets("Courant").Cells(Ligne, Column_Name("Nom*").Column) & vbNewLine)
        Call UIdoc.InsertText(Application.Substitute(vbNewLine & "@@Bien Cordialement,@Meriem", "@", vbCrLf))


        Call UIdoc.Paste

        Call UIdoc.Send(True)

        Call UIdoc.Close
        compteur_envoi = compteur_envoi + 1
        Set UIdoc = Nothing: Set WorkSpace = Nothing


    End If
   Set db = Nothing: Set Notes = Nothing

Next

Worksheets("Accueil").Cells(16, 3).Value = compteur_envoi
MsgBox "Envoi terminé"

End Sub

Thanks

Myriam AM
  • 61
  • 1
  • 6
  • Have you heard about MS Word, "Mail Merge" functionality? It works really well for your scenario ( Without writing a single line of code) – Barney Jan 06 '17 at 23:25
  • What line is the error on? It has to be before `.Address(1, 5, 1)`, because that's a subscript error (you're indexing a `String` as if it were a 3D array) Lacking any other information, I suspect `Column_Name` or `Column_Name_Previous` is returning 0 somewhere. Can you edit the question to include that code? Also, splitting `UsedRange.Address` on `$` to get the last row and column is, ummm, "interesting". See [this question](http://stackoverflow.com/q/71180/4088852) - the method for the last column is similar. – Comintern Jan 07 '17 at 14:49
  • I hope you know you can develop this entirely in Notes? Should be easy to do, just a few hours of work... – D.Bugger Jan 08 '17 at 16:10

1 Answers1

0

Finally the problem is fixed. There was not enough time between the document creation and the filter on filed 1. So, I need to put out the .AutoFilter declaration out of the Loop and add the criteria instanciation into the loop

Myriam AM
  • 61
  • 1
  • 6