[VBA] Problem with outmail function - function sends mails only to 1 recepient

Hello everyone,

This is my first post on this forum, so im glad to meet you experts .
Please help me with following my code.
It's part of code. Everything works, except one thing.
When we open dialog popup and choosing path, VBA is searching for all documents with *.pdf extension.
In order to name of file, code should send email with attached document to recipients.
If code finds "2222" in part of name file, email should go to company no 2. If code finds "1111", email should be send to another receiver.
But it doesnt work properly. It's only send 1 email (number 33333), but it should send all 3 emails (because I put 3 documents in folder with names: "11111", "22222" and "33333").

Can you help me and tell me where is mistake in my code? Im newbie at VBA so I will be grateful for forgiving attitude.

PHP Code: 

   Do While xFname$ <> ""
      
     If InStr(1, xFname$, "11111", vbTextCompare) > 0 Then
                    Temat = "Company 1111"
                    Tresc = "ple ple 1"
                       MsgBox ("Sent to company 11111")


                    ElseIf InStr(1, xFname$, "22222", vbTextCompare) > 0 Then
                            Temat = "Company 2222"
                            Tresc = "ple ple 2"
                              MsgBox ("Sent to company 22222")
                            

                            ElseIf InStr(1, xFname$, "33333", vbTextCompare) > 0 Then
                              Temat = "Company 3333"
                              Tresc = "ple ple 3"
                                     MsgBox ("Send to company 33333")



                    
             End If
             On Error Resume Next
            With OutMail
                                 .To = "my@mail.com"
                                 .CC = ""
                                 .BCC = ""
                                 .Subject = Temat
                                 .HTMLBody = Tresc
                                 .Attachments.Add ("C:\Users\plmackry\Desktop\testowy folder\565389963_33333.pdf")
                                 .Display
                                 .Send
                                     MsgBox ("Tresc")
                                 End With
                                 
                                 


         ActiveCell.Offset(xRow) = xFname$
         xRow = xRow + 1
         xFname$ = Dir
                  xDirect$ = .SelectedItems(1) & "\"
     Loop
   End If
   End With
  On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing 


Greetings,

Whenever the outmail code runs, you only specify the document in the path which is: ".Attachments.Add ("C:\Users\plmackry\Desktop\testowy folder\565389963_33333.pdf")"

For it to send another attachment according to the instr found you shoule instead put the ".Attachments.Add mystring" and consider the mystring as the path of the file to send.

Meaning :

if this statement is true InStr(1, xFname$, "11111", vbTextCompare) then
mystring = path of file with "11111"
else
goto next one

So you should just consider the mystring when you define Temar or Tresc.

Since you only compare the files and no attachment is placed according to the compared files the attachment will always be the one that you put in .Attachment.Add

Regards,
Daniel

noo. It's not important. I will change different mails after.

Now I'm trying to fix not working part code with sending emails. Email receiver can be at this moment the same: "Example@example.com".
Why script are send ONLY 1 email, when I have in folder 3 files corrected names.
Script should send one mail (doesnt matter what email) with subject "1111" if there exist pdf file named "1111",
second mail (subject 22222) should be send if script will find PDF named "2222", and third mail (3333 in subject) should be send if script will find PDF named "3333"

It would be better if you post any attachment with parts of your code so that your needs are understood correctly.

But i'm assuming that if no other email is sent more then once, then the loop ends after the first IF.

Create a breakpoint in your code and go step by step using F8 in VBA. i'm sure it will help you understand why the loop is not incrementing and ending instead.

Regards,
Daniel

Hello Daniel and Richard,
Already I'm managed with problem

Code works, I need add "call" instruction to each section "IF":

PHP Code: 

If InStr(1, xFname, "11111", vbTextCompare) > 0 Then
                    Adresmailowy = "firma1@firma.com"
                    Temat = "Firma 1111"
                    Tresc = "ple ple 1"
                       MsgBox ("WYSYŁAM DO Firmy 11111")
                       Call Mail2(Adresmailowy, Temat, Tresc, xFname, xDirect)


                    ElseIf InStr(1, xFname, "22222", vbTextCompare) > 0 Then
                            Adresmailowy = "firma2@firma.com"
                            Temat = "Firma 2222"
                            Tresc = "ple ple 2"
                              MsgBox ("Wysyłam do Firmy 22222")
                              Call Mail2(Adresmailowy, Temat, Tresc, xFname, xDirect)
                            

                            ElseIf InStr(1, xFname, "33333", vbTextCompare) > 0 Then
                              Adresmailowy = "firma3@firma.com"
                              Temat = "Firma 3333"
                              Tresc = "ple ple 3"
                                     MsgBox ("Wysyłam do Firmy 33333")
                                     Call Mail2(Adresmailowy, Temat, Tresc, xFname, xDirect) 


And I added outmail function in other section:

PHP Code: 

Sub Mail2(Adresmailowy As String, Temat As String, Tresc As String, xFname As String, xDirect As String)

    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    
                With OutMail
                           .To = Adresmailowy
                           .CC = ""
                           .BCC = ""
                           .Subject = Temat
                           .HTMLBody = Tresc
                           .Attachments.Add (xDirect & xFname)
                           .Display
                           .Send
                           
                     End With
                                 On Error GoTo 0
                                   Set OutMail = Nothing
End Sub 


And it works properly. It sends 3 mails if code found files named: "1111", "2222", "3333".
Thanks guys!