So this worked... at one point. Now, for some reason, it's throwing a code! I'm not sure what the issue is as I've gone through this with a fine tooth comb... hopefully someone else has either a) seen this issue and resolved it, or (more likely) see a problem with my coding that is causing this to come up this way.
Code
Option Explicit
Sub create_and_email_pdf()
Dim LastRowOCNNumber As Long, POREFNOColumn As Long, ConfirmationSentColumn As Long
Dim SheetConfirmation As Worksheet, SheetDashboard As Worksheet
Dim FindPOREFNOColumn As Range, FindConfirmationSentColumn As Range, OCNNumberRange As Range, OCNNumber As Range
Dim EmailSubject As String, emailsignature As String
Dim currentmonth As String, destfolder As String, PDFFile As String
Dim email_to As String, email_cc As String, email_bcc As String
Dim openpdfaftercreating As Boolean, alwaysoverwritepdf As Boolean, displayemail As Boolean
Dim overwritepdf As VbMsgBoxResult
Dim OutlookApp As Object, outlookmail As Object
currentmonth = ""
Set SheetConfirmation = Worksheets("Confirmations")
Set SheetDashboard = Worksheets("Dashboard")
Set FindPOREFNOColumn = SheetConfirmation.Rows(1).Find(What:="PO REFNO", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
If Not FindPOREFNOColumn Is Nothing Then
POREFNOColumn = FindPOREFNOColumn.Column
LastRowOCNNumber = SheetConfirmation.Cells(Rows.Count, POREFNOColumn).End(xlUp).Row
End If
Set FindConfirmationSentColumn = SheetConfirmation.Rows(1).Find(What:="Confirmation Sent?", LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
If Not FindConfirmationSentColumn Is Nothing Then
ConfirmationSentColumn = FindConfirmationSentColumn.Column
End If
Set OCNNumberRange = SheetConfirmation.Range(SheetConfirmation.Cells(2, POREFNOColumn), SheetConfirmation.Cells(LastRowOCNNumber, POREFNOColumn))
For Each OCNNumber In OCNNumberRange
If OCNNumber.Offset(, ConfirmationSentColumn - POREFNOColumn).Value = "no" Then
SheetDashboard.Range("E5").Value = OCNNumber.Value
OCNNumber.Offset(, ConfirmationSentColumn - POREFNOColumn).Value = "Yes"
EmailSubject = "Order Confirmation For " & [dashboard!e5].Value 'Change this to change the subject of the email. The current month is added to end of subj line
openpdfaftercreating = False 'Change this if you want to open the PDF after creating it : TRUE or FALSE
alwaysoverwritepdf = False 'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
displayemail = False 'Change this if you don't want to display the email before sending. Note, you must have a TO email address specified for this to work
email_to = Left([dashboard!e5].Value, 4)
email_cc = "ne06orders"
email_bcc = ""
'Current month/year stored in H6 (this is a merged cell)
currentmonth = Mid(ActiveSheet.Range("F19").Value, InStr(1, ActiveSheet.Range("F19").Value, " ") + 1)
'Create new PDF file name including path and file extension
PDFFile = destfolder & Application.PathSeparator & "Order Confirmation" & "_" & "NE06-" & [Dashboard!e7].Value _
& ".pdf"
'If the PDF already exists
If Len(Dir(PDFFile)) > 0 Then
If alwaysoverwritepdf = False Then
overwritepdf = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
'If you want to overwrite the file then delete the current one
If overwritepdf = vbYes Then
Kill PDFFile
Else
MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Else
On Error Resume Next
Kill PDFFile
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
'Create the PDF
ThisWorkbook.Worksheets("Submittal").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="PDFFile.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
From:=1, To:=1, _
OpenAfterPublish:=False
'Create an Outlook object and new mail message
Set OutlookApp = CreateObject("Outlook.Application")
Set outlookmail = OutlookApp.CreateItem(0)
'Display email and specify To, Subject, etc
With outlookmail
.Display 'Use .Display to open email prior to sending
.To = email_to
.CC = email_cc
.BCC = email_bcc
.Subject = EmailSubject & currentmonth
.Attachments.Add "PDFFile.pdf" '****************This seems to be where the code is coming from********************
If displayemail = False Then
.Display
End If
End With
End If
Next OCNNumber
End Sub
Display More
Anyone have any thoughts here? I'm lost and not sure what direction to head...
Thx.
MA