Unable to get my automatic Signature to work in my code

[Florida1510]

Sub senEmailsToMultiplePersonsWithMutlpleAttachments()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)

'path/file names are entered in the columns G:M in each row
Set rng = sh.Cells(cell.Row, 1).Range("G1:M1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.TO = sh.Cells(cell.Row, 1).Value
.CC = sh.Cells(cell.Row, 2).Value
.Subject = sh.Cells(cell.Row, 3).Value
.HTMLBody = "Hi All <br>" _
& "<br>Its been found that the below APN has been inactive in our system from more than 6 months. Please confirm if you are or in future will be using this APN, if not it will be moved out of system accordingly.<br>" _
& "<br>APN =" & sh.Cells(cell.Row, 4).Value & "<br>" _
& "<br>Account Name =" & sh.Cells(cell.Row, 5).Value & "<br>" _
& "<br>Account ID =" & sh.Cells(cell.Row, 6).Value & "<br>" _
& "<br>Thank you <br>" _

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)

If Trim(FileCell.Value) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value

End If
End If

Next FileCell
'.Send
.display
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing

With Application
.EnableEvents = True
.ScreenUpdating = True
End With


End Sub

 

[Dan_W]

And?

 

[Florida1510]

Dan_W, nothing worked for some reason the code is removing my auto signature and I don't know where or how in the code to add it back.

 

[Dan_W]

Ordinarily, when people come to a forum seeking answers to problems, they usually set out the problem and ask for guidance or help with the actual code, and one can usually find a "hello", "please" or "thank you" somewhere in their post. Sometimes, all three!

You don't often come across a "Code doesn't work", and then the code ... and nothing else. But whatever.

Try the following code. I haven't checked it.

Sub senEmailsToMultiplePersonsWithMutlpleAttachments()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)

'path/file names are entered in the columns G:M in each row
Set rng = sh.Cells(cell.Row, 1).Range("G1:M1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

Dim Signature As String
Signature = OutMail.HTMLBody

With OutMail
.TO = sh.Cells(cell.Row, 1).Value
.CC = sh.Cells(cell.Row, 2).Value
.Subject = sh.Cells(cell.Row, 3).Value
.HTMLBody = "Hi All <br>" _
& "<br>Its been found that the below APN has been inactive in our system from more than 6 months. Please confirm if you are or in future will be using this APN, if not it will be moved out of system accordingly.<br>" _
& "<br>APN =" & sh.Cells(cell.Row, 4).Value & "<br>" _
& "<br>Account Name =" & sh.Cells(cell.Row, 5).Value & "<br>" _
& "<br>Account ID =" & sh.Cells(cell.Row, 6).Value & "<br>" _
& "<br>Thank you <br><br>" & Signature

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)

If Trim(FileCell.Value) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value

End If
End If

Next FileCell
'.Send
.display
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

 

[Florida1510]

Dan, my apologies I never want to come across I grateful I truly appreciate this forums help and yours today. I do apologize I was quick when I responded and should have been more thougful since you took time out of your day to assist a complete stranger. Thank you for all of your help and have a great rest of your day!

Owen

 

[Dan_W]

Dan, my apologies I never want to come across I grateful I truly appreciate this forums help and yours today. I do apologize I was quick when I responded and should have been more thougful since you took time out of your day to assist a complete stranger. Thank you for all of your help and have a great rest of your day!

Owen

Thank you. I do appreciate the apology.
To explain, what was happening was that the signature was being generated together with the email, but your code wrote over it when it automatically assigned a new string to the HTMLBody property. There were a few ways around it, but the one I opted for was to store the entire signature, etc in a variable, and then tack that onto the new message you were autogenerating.
I gather that the code worked from the fact that you marked it as the solution. Please do let me know if you have any other difficulties.

 

[Florida1510]

Hi Dan yes thank you the code did work and I appreciate the education. I’m very new to working with VBA it is really an art most people’s brains just don’t get it I’m in between I just know enough to get 95% of the way complete to run into something like this. This forum is a godsend I think everyone that has used it agrees and appreciates all of your assistance. Thanks again have a great rest of your day.

Owen