Dynamic Save to Folder Based on Cell Contents

[dthhal]

Hello All,
Thanks to Mania112 I have a great code that sends a PDF via email of my worksheet. And thanks to Leith it is working wonderfully with the few tweaks he provided. Now I need to take it to the next level and could use some more help. Im not sure if this is possible but here goes:
I have my code creating a file name made up of text and cell references

TempFileName = TempFilePath & sh.Name & "%" & Range("C7") & "%" & Range("L9") & ".pdf"

On a shared drive I have folders for our different pieces of equipment. These folder names are the same as cell "C7" inputs in my worksheet. Cell "C7" is changed by the user when working on a specific piece of equipment, and is that equipments ID#. What I need to have happen is save the created PDF to the specific equipment ID# folder on my shared drive (H:/). This macro is fired by button click. The path to the proper folder would need to change every time cell "C7" changed in order to go into the proper folder. I assume this save would need to happen prior to the killing of the temp file. But where exactly, and what would I need to have as the code to do this dynamic save?
Thank you all in advance for your help. Here is the full code I have.

Private Sub Save_SendToPlanner_Click()
ActiveSheet.Unprotect Password:="rental"
'Working only in 2007
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
 
    TempFilePath = Environ$("temp") & "\"
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
 
    Set sh = ThisWorkbook.ActiveSheet
        If sh.Range("c7").Value > "0" Then
 
            TempFileName = TempFilePath & sh.Name & "%" & Range("C7") & "%" & Range("L9") & ".pdf"
 
            'We Publish to PDF
            On Error Resume Next
            sh.ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    Filename:=TempFileName, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
            On Error GoTo 0
            AdditionalText = AdditionalText & Range("C7") & Chr(13) & Range("H7") & Chr(13) & Range("H5") & Chr(13) & Range("L5") & Chr(13)
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = ""
                .CC = ""
                .BCC = ""
                .Subject = "QC Report"
                .Body = AdditionalText & Chr(13) & "Planner, Please save this QC Report to the proper file." & Chr(13) & Chr(13) & "Regards," & Chr(13) & "QC Generator"
                .Attachments.Add TempFileName
                .Display   'or use .Send
                On Error GoTo 0
            End With
            Set OutMail = Nothing
 
            If Dir(TempFileName) <> "" Then Kill TempFileName
        End If
    
    Set OutApp = Nothing
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
 
   ActiveSheet.Protect Password:="rental"
    End With
    
End Sub

[dthhal]

I hope everyone had a good weekend.

Any thoughts on my question above?

[Leith Ross]

Hello dthhal,

I don't have Excel 2007 so I am not sure the changes I made will work. Try it out and let me know. Here is code with changes marked in blue. The Temp File is moved to the new location.

Private Sub Save_SendToPlanner_Click()
ActiveSheet.Unprotect Password:="rental"
'Working only in 2007
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
 
    TempFilePath = Environ$("temp") & "\"
 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
 
    Set sh = ThisWorkbook.ActiveSheet
        If sh.Range("c7").Value > "0" Then
 
            TempFileName = sh.Name & "%" & Range("C7") & "%" & Range("L9") & ".pdf"
 
            'We Publish to PDF
            On Error Resume Next
            sh.ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    FileName:=TempFilePath & TempFileName, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
            On Error GoTo 0
            AdditionalText = AdditionalText & Range("C7") & Chr(13) & Range("H7") & Chr(13) & Range("H5") & Chr(13) & Range("L5") & Chr(13)
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = ""
                .CC = ""
                .BCC = ""
                .Subject = "QC Report"
                .Body = AdditionalText & Chr(13) & "Planner, Please save this QC Report to the proper file." & Chr(13) & Chr(13) & "Regards," & Chr(13) & "QC Generator"
                .Attachments.Add TempFileName
                .Display   'or use .Send
                On Error GoTo 0
            End With
            Set OutMail = Nothing
 
            If Dir(TempFileName) <> "" Then
               Name TempFilePath & TempFileName As "H:\" & TempFileName
            End If
        End If
    
    Set OutApp = Nothing
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
 
   ActiveSheet.Protect Password:="rental"
    End With
    
End Sub

[dthhal]

Thanks Leith. I'll give it a try and let you know. I appreciate you help once again.

[dthhal]

Hi Leith,
I have tried the code and unfortunately have had no luck. The macro will run without errors, but no longer creates the .pdf in the email, nor saves to the shared drive. I have tried manipulating the code to the best of my ability but fall short. Any other thoughts on how I might accomplish it? I have attached a workbook for an example of what Im trying to accomplish.

Also, to help clarify the path it would need to be as follows:

H:\Folder1\Sub Folder1\Sub Folder2\QC Sheet\Sheet Range "C7"\ & TempFileName

The Sheet Range"C7" is a user input for an equipment number. Each piece of equipment has its own folder so the save would need to be directed to the proper folder based on C7.

Thanks for the help.

[Leith Ross]

Hello dthhal,

Unfortunately, I don't have Excel 2007 and I don't have an Add-In to produce PDF files. I try looking over the code and see if I can locate any errors in the code or logic (quite possible).