strangejosh
New Member
- Joined
- Jul 30, 2022
- Messages
- 15
- Office Version
- 2019
- Platform
- Windows
Hello,
I was hoping someone could help me with my code. Thank you for the user @Sequoyah for helping with the original code. That was very helpul.
So basically the code loops through an excel spreadsheet, looks for unique vendors and sends their past due orders to them in the body of an email. It works fine however some of the columns are wrapped while others aren't. Also all of the headers are also wrapped. Is there a way to prevent that from happening for columns / rows?
See below of what the spreadsheet that is to have the code run on it.
Then see what gets returned. Not sure why those 2 columns specifically get wrapped?
Also, is there a way for the code to allow a filter to by applied and then run as normal? Column A Buyer Code may have multiple diferent buyers and say I only want to send emails for specific buyer codes can I filter and just have those send?
See code below.
I was hoping someone could help me with my code. Thank you for the user @Sequoyah for helping with the original code. That was very helpul.
So basically the code loops through an excel spreadsheet, looks for unique vendors and sends their past due orders to them in the body of an email. It works fine however some of the columns are wrapped while others aren't. Also all of the headers are also wrapped. Is there a way to prevent that from happening for columns / rows?
See below of what the spreadsheet that is to have the code run on it.
Then see what gets returned. Not sure why those 2 columns specifically get wrapped?
Also, is there a way for the code to allow a filter to by applied and then run as normal? Column A Buyer Code may have multiple diferent buyers and say I only want to send emails for specific buyer codes can I filter and just have those send?
See code below.
VBA Code:
Sub mailstrangejosh()
Dim OutApp As Object, OutMail As Object
Dim myRng As Range, v As Variant
Dim j As Long, lastRow As Long
Dim strbody As String
Application.ScreenUpdating = False
lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
v = Range("A1:V" & lastRow).Value
Set OutApp = CreateObject("Outlook.Application")
With CreateObject("scripting.dictionary")
For j = 2 To UBound(v)
If Not .exists(v(j, 2)) Then
.Add v(j, 2), Nothing
strbody = "Hello " & v(j, 20) & “,” & "<br>" & _
"<br>" & _
"Please see below past due order(s) balances and provide a status update when you can. Thank you" & "<br/><br>"
With ActiveSheet
.Range("A1").AutoFilter 2, v(j, 2)
Set myRng = .Range("A1:X" & lastRow).SpecialCells(xlCellTypeVisible)
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = v(j, 21)
.Subject = v(j, 17) & " – PO Balance(s)"
.HTMLBody = strbody & RangetoHTML(myRng)
.display 'to show
'.Send 'to send
End With
End With
End If
Next j
End With
Range("A1").AutoFilter
Application.ScreenUpdating = True
End Sub
Function RangetoHTML(myRng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
Dim i As Integer
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
myRng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
Cells(1).Select
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
For i = 7 To 12
With .UsedRange.Borders(i)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
Next i
End With
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")
RangetoHTML = Replace(RangetoHTML, "display:none", "")
TempWB.Close savechanges:=False
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function