Working with 2 workbooks, problem with PDF creation

[Fraser_Burnett]

Morning All,

I have two workbooks, "Material_Orders.xlsm" and "testMCosts.xls". within the "Material_Orders.xlsm" i have a script in place which will initially take a cell from that workbook and open the "testMCosts.xls" pasting the cell. It then hyperlinks the pasted cell and links this to a created PDF.

The issue i am having with the script is that it is creating a PDF of the "testMCosts.xls" file and hyperlinking to this. It should be creating a PDF of the "Material_Orders.xlsm".

I have included the code below and any assistance to resolve this would be very much appreciated.

This is the final hurdle to get these sheets working

Option Explicit
    Dim PdfFile As String
    Dim ThisWBsheet As Worksheet
    
    


Sub test_send_save_cost_hyper()
    Dim wbTarget As Workbook, stWB As String
    Dim shTarget As Worksheet, stSh As String
    Dim stTerm As String, stCost As Single
    Dim fnd As Range, nextRow As Long
    Dim rgHyperLink As String
    
    stWB = "Testmcost.xlsx"
    stSh = "mcosts"
    stTerm = Range("C3")
    stCost = Range("J40")
    
    Set ThisWBsheet = ThisWorkbook.ActiveSheet
    Set wbTarget = Workbooks.Open(ThisWorkbook.Path & "/" & stWB)
    Set shTarget = wbTarget.Sheets(stSh)
    
    Set fnd = shTarget.Rows(1).Find(stTerm, , , xlWhole)
    If Not fnd Is Nothing Then
        nextRow = shTarget.Cells(Rows.Count, fnd.Column).End(xlUp).Row + 1
        With shTarget.Cells(nextRow, fnd.Column)
            .Value = stCost
            .Offset(, -1) = Now
            rgHyperLink = .Address
        End With
        CreatePDF
        ActiveSheet.Hyperlinks.Add Anchor:=Range(rgHyperLink), _
                          Address:=ThisWBsheet.Range("O3") & "/" & PdfFile
        wbTarget.Close True  'close book WITH changes
        emailandsend
    Else
        MsgBox stTerm & " not found"
        wbTarget.Close False  'close book WITHOUT changes
    End If
End Sub


Private Sub CreatePDF()
    ' Define PDF filename
    PdfFile = ThisWBsheet.Range("m5") & "_" & Format(Now(), "ddmmyyyy_hhmm")
    PdfFile = PdfFile & ".pdf"
    
    ' Export activesheet as PDF
    With ActiveSheet
      .ExportAsFixedFormat Type:=xlTypePDF, _
                       Filename:=ThisWBsheet.Range("m3") & "\" & PdfFile, _
                        Quality:=xlQualityStandard, _
           IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, _
               OpenAfterPublish:=False
    End With
    
    With ActiveSheet
      .ExportAsFixedFormat Type:=xlTypePDF, _
                       Filename:=ThisWBsheet.Range("m4") & "\" & PdfFile, _
                        Quality:=xlQualityStandard, _
           IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, _
               OpenAfterPublish:=False
    End With
End Sub


Private Sub emailandsend()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim Title As String
  Dim OutlApp As Object
 
  ' Not sure for what the Title is
  Title = Range("m5") & "_" & Format(Now(), "ddmmyyyy_hhmm")
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = Title
    .To = Range("m6")  ' <-- Put email of the recipient here
    .CC = " " ' <-- Put email of 'copy to' recipient here
    .Body = Range("m7")
    .Attachments.Add ThisWBsheet.Range("m3").Value & "\" & PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing
 
End Sub

 

[Fraser_Burnett]

Running through the debugger one line at a time, everything works up to the Private sub createpdf. It would appear this need to point back to the origional workbook - "fraser_material_order.xlsm" and sheet "order_sheet" beofre creating the PDF.

Iwas origionally given assistance to create this script on this site and my knowledge is not enough to know how to edit this script to change this.

Also the way that the first sub script is set out for the hyperlink it is looking at:-

ActiveSheet.Hyperlinks.Add Anchor:=Range(rgHyperLink), _                          Address:=ThisWBsheet.Range("m3") & "/" & PdfFile

the location of "m3" is not in the active workbook at time of hyperlinking it is in the first workbook "Fraser_material_order.xlsm".

please help