Read row one by one

[dwarek]

hello everyone i have created a vba code to send email via outlook now i have to do one thing it is to read the first row and next and next , for example in A2 ,A3....... so on there are list of email recipient to be added to the field (TO of Outlook) and B2,B3... C1,C2.... so on there are text to be added to the field (BODY of the outlook) . so i need to program like read first row then extract data from A2 and pass it TO OF OUTLOOK and then Extract from B2,C2 and pass to BODY OF OUTLOOK then move to next row like A3,B3,C3 then A4,B4,C4 ....... and so on any idea how can program this. I guess i need to create a for loop but i don't know exactly how to make it .Below i have given my program please help me out

Private Sub CommandButton1_Click()
Dim Rng As Range, c As Range




Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMail

.To = Range("A2")
.CC = ""
.BCC = ""
.Subject = "test"
.Body = Range"B2")
.Display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

 

[BarryL]

I have something like the below in my office. I'm not a big fan of While or ActiveCell (as I'd imagine most people aren't) but you could easily change the loop.

Range("A2").Select

While Not ActiveCell = ""

Mail_To = ActiveCell.Offset(0, 1)
Mail_Cc = ActiveCell.Offset(0, 2)
Mail_Subject = ActiveCell.Offset(0, 3)
Mail_Voting = ActiveCell.Offset(0, 4)






Set myolapp = CreateObject("Outlook.Application")
    Set myitem = myolapp.CreateItem(olMailItem)

    With myitem
    

         .VotingOptions = Mail_Voting
         .To = Mail_To
         .Cc = Mail_Cc
         .Subject = Mail_Subject
         .Body = "Hi," & Chr(13) & Chr(13) & "x." & Chr(13) & Chr(13) & "x." & Chr(13) & Chr(13) & "Regards," & Chr(13) & "x," & Chr(13) & Chr(13) & ""
         .Send
    End With
    
ActiveCell.Offset(1, 0).Select
Wend

 

[dwarek]

thank you barryl i will try to use this code and let you know in a while

 

[dwarek]

Thank you barryl it worked and i have edited according to my needs

 

[BarryL]

you are welcome

 

[dwarek]

hi barryl i have a question i have edited vba code according to my need but i need to add signature to those emails is it possible ? the below one is my code

Private Sub CommandButton1_Click()
Range("A2").Select
While Not ActiveCell = ""
Mail_To = ActiveCell.Offset(0, 0)
Mail_Subject = "testing"
Mail_Voting = ActiveCell.Offset(0, 4)
Set myolapp = CreateObject("Outlook.Application")
Set myitem = myolapp.CreateItem(olMailItem)
With myitem



.VotingOptions = Mail_Voting
.To = Mail_To

.Subject = ActiveCell.Offset(0, 1)
.body = ActiveCell.Offset(0, 2)


.display
End With

ActiveCell.Offset(1, 0).Select
Wend
End Sub


Private Sub CommandButton2_Click()
Unload UserForm2
End Sub

 

[BarryL]

can you try the below?

Sub mailmacro()

  Dim OlApp As Outlook.Application
  Dim ObjMail As Outlook.MailItem

  Dim BodyHtml As String
  Dim DirSig As String
  Dim FileNameHTMSig As String
  Dim Pos1 As Long
  Dim Pos2 As Long
  Dim SigHtm As String
  
  For Each rng In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)

  DirSig = "C:\Users\" & Environ("username") & _
                               "\AppData\Roaming\Microsoft\Signatures"

  FileNameHTMSig = Dir$(DirSig & "\*.htm")

  ' Code to handle there being no htm signature or there being more than one

  SigHtm = GetBoiler(DirSig & "\" & FileNameHTMSig)
  Pos1 = InStr(1, LCase(SigHtm), "<body")

  ' Code to handle there being no body

  Pos2 = InStr(Pos1, LCase(SigHtm), ">")

  ' Code to handle there being no closing > for the body element

   BodyHtml = "<table border=0 width=""100%"" style=""Color: #0000FF""" & _
         " bgColor=#F0F0F0><tr><td align= ""center"">HTML table</td>" & _
         "</tr></table><br>"
  BodyHtml = Mid(SigHtm, 1, Pos2 + 1) & BodyHtml & Mid(SigHtm, Pos2 + 2)

Dim mailto As String
Dim voting As String

mailto = rng.Value
voting = rng.Offset(0, 4).Value

  Set OlApp = Outlook.Application
  Set ObjMail = OlApp.CreateItem(olMailItem)
  ObjMail.BodyFormat = olFormatHTML
  ObjMail.Subject = "Subject goes here"
  ObjMail.Recipients.Add mailto
  ObjMail.Body = rng.Offset(0, 2).Value
  ObjMail.VotingOptions = voting
  ObjMail.Display
Next
End Sub

Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function

 

[BarryL]

body html should equal actual text. you'll find it on this link midway through the convo

http://stackoverflow.com/questions/8994116/how-to-add-default-signature-in-outlook