Help clean up my Macro, Thanks!

[dodgeking3171]

Hey guys, So here is what i have going on. I am having excel pull data from a access table with a query, Then that data is being put into a pivot table. That table contains a supplier/vendor, the part number, and the amount of parts of that part number i sold today. I currently have the table set to filter out all the suppliers ( and therefore all the data, ) to the blank supplier. This is fine.

I am using a macro to take that table one supplier at a time and email them the parts list. And the macro is working in the baiscs of what im trying to make it do. problem is im a novice at this, Ive built this macro with recording and reading online and coming up with the coding, however i dont fully know what all the coding is calling for, and thats where my problem comes in

I want it to email as a PDF, and i thought i solved that problem, I am getting the page to save as a PDF to the Folder i want it to, Score, However, i am not emailing the pdf. Im emailing the sheet and i dont want to do that. I changed this part of the code

Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select


I changed all the "xlsx" to pdf, and i thought i got it. however, the file its emailing is corrupt.


Also, i tried to change the attachment from the destwb to the file i just saved, however i went about it like this


With OutMail
.To = "nateb.jennb@gmail.com"
.CC = ""
.BCC = ""
.Subject = " STOCK ORDER DAY OF" _
& Format(Now, "dd-mmm-yy h-mm-ss")
.Body = "Hello World!"

.Attachments.Add ("C:\Users\PARTS1\Desktop\Stock Order\ALLSTATE STOCK ORDER DAY OF" _
& Format(Now, "dd-mmm-yy h-mm-ss")")

.Send


However that sets a error of its own, but the file name will change daily as the date is part of the name, Im not sure how to call that automatically.


The next and last problem i see right now is that it opens up a new book every time. book 22 book 23 book 24 ect. how do i stop that?

The whole code is below. I will mold it more into my own later but need this help to make sure i have function down first

Sub rullall()
Call Mail_Allstate
Call Mail_Boyertrucks
End Sub
Sub Mail_Allstate()
'
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object


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


Set Sourcewb = ActiveWorkbook


Sheets("Sheet2").Copy
Set Destwb = ActiveWorkbook


With Destwb
If Val(Application.Version) < 12 Then
'
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select

End If
End With


' we use the below code to show the current supplier


With ActiveSheet.PivotTables("PivotTable1").PivotFields("Supplier")
.PivotItems("ALLSTATE SALES CORP").Visible = True
.PivotItems("(blank)").Visible = False
End With


' we use the below code to stop a sub so we do not mail a blank order to a supplier
If Sheets("Sheet2").Range("b5").Value = "" Then Exit Sub




TempFileName = "ALLSTATE STOCK ORDER DAY OF" _
& Format(Now, "dd-mmm-yy h-mm-ss")


ChDir _
"C:\Users\PARTS1\Desktop\Stock Order"
Sheets("Sheet2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFileName, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)


With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next

With OutMail
.To = "nateb.jennb@gmail.com"
.CC = ""
.BCC = ""
.Subject = " STOCK ORDER DAY OF" _
& Format(Now, "dd-mmm-yy h-mm-ss")
.Body = "Hello World!"
.Attachments.Add Destwb.FullName

.Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With



Kill TempFilePath & TempFileName & FileExtStr
' use this code to render it back to blank,
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Supplier")
.PivotItems("ALLSTATE SALES CORP").Visible = False
.PivotItems("(blank)").Visible = True
End With

Set OutMail = Nothing
Set OutApp = Nothing


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


Sub Mail_Boyertrucks()
'
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object


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


Set Sourcewb = ActiveWorkbook


Sheets("Sheet2").Copy
Set Destwb = ActiveWorkbook


With Destwb
If Val(Application.Version) < 12 Then
'
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select

End If
End With





With ActiveSheet.PivotTables("PivotTable1").PivotFields("Supplier")
.PivotItems("Boyer Ford Trucks").Visible = True
.PivotItems("(blank)").Visible = False
End With




If Sheets("Sheet2").Range("b5").Value = "" Then Exit Sub






TempFileName = "Boyer STOCK ORDER DAY OF" _
& Format(Now, "dd-mmm-yy h-mm-ss")


ChDir _
"C:\Users\PARTS1\Desktop\Stock Order"
Sheets("Sheet2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFileName, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)


With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next

With OutMail
.To = "nateb.jennb@gmail.com"
.CC = ""
.BCC = ""
.Subject = " STOCK ORDER DAY OF" _
& Format(Now, "dd-mmm-yy h-mm-ss")
.Body = "Hello World!"
.Attachments.Add Destwb.FullName

End With
On Error GoTo 0
.Close SaveChanges:=False
End With




Kill TempFilePath & TempFileName & FileExtStr


With ActiveSheet.PivotTables("PivotTable1").PivotFields("Supplier")
.PivotItems("Boyer Ford Trucks").Visible = False
.PivotItems("(blank)").Visible = True
End With

Set OutMail = Nothing
Set OutApp = Nothing


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




again i appreciate the help. if i can get the mail to go as a pdf with the TempFileName and get it to stop opening a new book, i would be set i believe. Thanks for any advice. if you need the workbook i can provide that too, its not a secret. I just dont know how to provide it on here

 

[dodgeking3171]

Well I thought i got closer, some reason the books wernt popping up anymore, but then they started again, it seems like there is a trigger in the macro that causes it if there is a fail of some sort, gotta pay more attention to when they pop up