Thread: [Solved] pause VBA code to view PDF file then continue or cancel
View Single Post
 
Old 06-16-2018, 02:08 AM
trevorc trevorc is offline Windows 7 32bit Office 2013
Competent Performer
  
Join Date: Jan 2017
Posts: 173
trevorc will become famous soon enoughtrevorc will become famous soon enough
Default pause VBA code to view PDF file then continue or cancel
Hi all,
I have the code below that creates a quote for our customers, it all works ok, but is it possible to interupt the VBA from running just after the PDF file is created so I can inspect the PDF and endsure that I have entered all the details correctly, if not delete the PDF file and cencel running the rest of the VBA code or return to the VBC code and continue to create the Email. I have set the PDF to OpenAfterPublish:=False, but I can change this to true and it will open the PDF file for viewing. The PDF file is created from the spreadsheet data when the date field is double clicked. At the moment it continues until the email is generated and displayed on screen waiting to be sent. (Later I may have it just send the email via automation)

Do I just need to add a msgbox to allow a seletion of continue or cancel after the PDF file is created. Delete the file and cancel or continue.

Code:
        Dim MailOutLook
        Dim olmailItem
        Dim AppOutLook
        Set AppOutLook = CreateObject("Outlook.Application")
        Set MailOutLook = AppOutLook.CreateItem(olmailItem)
        If Not Intersect(Target, Sh.Range("B4:B5000")) Is Nothing Then
        t = MsgBox("Select Yes to continue snd..." & vbCrLf & vbCrLf & _
        "Create a Quote for the customer" & vbCrLf & _
        "Save it to the quotes directory in PDF format" & vbCrLf & _
        vbCrLf & _
        "Create an Email to the customer" & vbCrLf & _
        "Including the quote and a blank RMA form" & vbCrLf & vbCrLf & _
        "If you do not want to do this select Cancel", vbOKCancel, "Confirmation to Continue ")
        If t = 2 Then Exit Sub
        
            Sheets("quote").Range("D2") = Date
            Sheets("quote").Range("B2") = Range("a" & Mid(ActiveCell.Address, 4, 4))
            Sheets("quote").Range("B3") = Range("g" & Mid(ActiveCell.Address, 4, 4))
            Sheets("quote").Range("D3") = Range("i" & Mid(ActiveCell.Address, 4, 4))
            Sheets("quote").Range("D4") = Range("j" & Mid(ActiveCell.Address, 4, 4))
            Sheets("quote").Range("B7") = Range("b" & Mid(ActiveCell.Address, 4, 4))  'part
            Sheets("quote").Range("D7") = Range("c" & Mid(ActiveCell.Address, 4, 4))  'part
            Sheets("quote").Range("D9") = Range("f" & Mid(ActiveCell.Address, 4, 4))  'part
            Sheets("quote").Range("B8") = Range("d" & Mid(ActiveCell.Address, 4, 4))  'description
            Sheets("quote").Range("B9") = Range("e" & Mid(ActiveCell.Address, 4, 4))    'serial number
            Sheets("quote").Range("B10") = Range("n" & Mid(ActiveCell.Address, 4, 4))    'location
            Sheets("quote").Range("B11") = Range("o" & Mid(ActiveCell.Address, 4, 4))    'parts/items missing
            Sheets("quote").Range("B12") = Range("p" & Mid(ActiveCell.Address, 4, 4))    'repaorted fault
            Sheets("quote").Range("B13") = Range("q" & Mid(ActiveCell.Address, 4, 4))    'faults found
            Sheets("quote").Range("B14") = Range("r" & Mid(ActiveCell.Address, 4, 4))    'faults found
            Sheets("quote").Range("B15") = Range("v" & Mid(ActiveCell.Address, 4, 4))    'parts used
            Sheets("quote").Range("B16") = Range("s" & Mid(ActiveCell.Address, 4, 4))    'repair tech
            Sheets("quote").Range("D16") = Range("t" & Mid(ActiveCell.Address, 4, 4))    'repair tech
            Sheets("quote").Range("D19") = Range("u" & Mid(ActiveCell.Address, 4, 4))    'repair tech
            cdt = Sheets("Automation Data").Range("A10")
            ChDir cdt
            rma_file_name = cdt & "RMA - " & Range("a" & Mid(ActiveCell.Address, 4, 4)) & ".pdf"
            Sheets("quote").ExportAsFixedFormat Type:=xlTypePDF, Filename:=rma_file_name, Quality:=xlQualityStandard, _
                                                        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            With MailOutLook
                .To = Range("k" & Mid(ActiveCell.Address, 4, 4))
                .Subject = "Repair Quote for - RMA # " & Sheets("Customer").Range("a" & Mid(ActiveCell.Address, 4, 4)) _
                         & ", Serial Number " & Sheets("Customer").Range("e" & Mid(ActiveCell.Address, 4, 4))
                .Attachments.Add rma_file_name
                ttt = Sheets("Automation Data").Range("A7")
                .Attachments.Add ttt
                .Body = "Please find attached our quote for the repair" & vbCrLf & _
                        "RMA Number - " & Sheets("Customer").Range("a" & Mid(ActiveCell.Address, 4, 4)) _
                      & ", Serial Number " & Sheets("Customer").Range("e" & Mid(ActiveCell.Address, 4, 4)) & _
                        vbCrLf & vbCrLf & Sheets("Automation Data").Range("A4") & vbCrLf & vbCrLf & vbCrLf & "Regards," & vbCrLf & "Trevor" & vbCrLf & _
                        "Workshop Repair Technician" & vbCrLf & _
                        "Phone  " & vbCrLf & _
                        "Mobile " & vbCrLf & _
                        "E-mail   " & vbCrLf & _
                        "Any views expressed in this Communication..."
                .Display
            End With
 
 

            Sheets("Quote").Select
        End If
Reply With Quote