pause VBA code to view PDF file then continue or cancel

trevorc · #1 06-16-2018, 02:08 AM

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

Logit · #2 06-16-2018, 09:08 PM

.
If it were me .. I would allow the PDF to display after creation. Review the PDF and decide if it requires editing.

In your macro code, just before "With MailOutLook" which is right after the creation of the PDF file, insert this macro code :

Code:

Dim Msg As String, Title As String
  Dim Config As Integer, Ans As Integer
  Msg = "Approve sending the PDF file ? "
 
 
  Title = "Proceed YES / NO "
  Config = vbYesNo + vbQuestion
  Ans = MsgBox(Msg, Config, Title)
  If Ans = vbYes Then GoTo continue:
  If Ans = vbNo Then Exit Sub
continue:

This will give you an opportunity to choose continuing with the PDF as is, or exiting the email macro completely so you can make changes to the PDF.

trevorc · #3 06-17-2018, 12:45 AM

Thanks for your idea, I've gone a bit past that now

Code:

        Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
 

Sub Close_Adobe_Reader()
    Const WM_CLOSE = &H10
    Dim strClassName As String
    strClassName = "AcrobatSDIWindow"
    hwnd = FindWindow(strClassName, vbNullString)
    If hwnd Then
        SendMessage hwnd, WM_CLOSE, 0, ByVal 0&
    Else
        MsgBox "Adobe is not running !"
    End If
End Sub

        tt = MsgBox("Select Yes to continue if..." & vbCrLf & vbCrLf & _
                        "The PDF file is correct and has all information" & vbCrLf & _
                        vbCrLf & vbCrLf & _
                        "If you do not want to do this ensure that the PDF file reader is closed then select Cancel and the PDF file will be deleted", vbOKCancel, "Confirmation to Continue ")
            If tt = 2 Then
                Call Close_Adobe_Reader
                Kill (rma_file_name)
                Exit Sub
            Else
            End If

Logit · #4 06-17-2018, 09:46 AM

..
Probably best to mark this thread SOLVED if you have moved on to other aspects of your project.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
What Causes Outlook to Continue Changing File Size While Closed?	chasfh	Outlook	2	04-14-2018 06:32 AM
Displaying Code in a task usage view	ksa5024	Project	1	06-15-2016 06:15 PM
Stop macro if no file is selected in dialog box (when user presses cancel instead of selecting file)	spencerw.smith	Word VBA	2	08-12-2014 07:56 AM
How to save a PPT file in 'Reading View' to be opened always in 'Reading View'	ItzVickey	PowerPoint	2	08-08-2012 09:23 AM
How do you view the source code in a Word 10 web document?	provlima	Word	2	05-25-2012 01:12 PM