Print and Save to specific folder indicated by cel in worksheet.

[WERNER SLABBERT]

Morning all you smart people...
i have a vba code that saves and prints a document to a folder. i would like to expand it somewhat to ref a cell and then save the doc to the right folder.
currently it just saves to one folder. i need it to look at 'B9' and the find the corresponding folder and if it does not exist create it. the save the doc with the data from two other cells. 'G11 & C11'
the data in "B9' changes to the user need from a drop down from " Quote , Invoice , Job Card & Statement ", G11 & C11 respectively are the customer name and document nr.

Sub PrintSave()On Error Resume Next 'In case it already exists
MkDir GetSpecialfolder(CSIDL_DESKTOP) & "\Quotes"


    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
    Dim Filename As String
    Dim Path As String
    Filename = Range("L1").Value
    Path = CreateObject("Wscript.Shell").specialfolders("Desktop")
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Path & "\Quotes\" & Filename & ".Pdf", Quality:= _
        xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End Sub

 

[AlphaFrog]

[color=darkblue]Sub[/color] PrintSave()
    
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color], strFileName [color=darkblue]As[/color] [color=darkblue]String[/color]
    
    strPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Range("B9").Value & "\"
    [color=darkblue]If[/color] Dir(strPath, vbDirectory) = "" [color=darkblue]Then[/color] MkDir strPath
        
    strFileName = Range("G11").Value & Range("C11").Value
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=[color=darkblue]False[/color]
        
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=strPath & strFileName & ".pdf", _
                                    Quality:=xlQualityMinimum, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=[color=darkblue]False[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[WERNER SLABBERT]

There is a reason you're called MVP. thanx a whole heap it works hundreds...

Just one more random question, how can i generate random doc numbers on open. but as not to have them repeat on me...?

[COLOR=darkblue]Sub[/COLOR] PrintSave()
    
    [COLOR=darkblue]Dim[/COLOR] strPath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], strFileName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    
    strPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Range("B9").Value & "\"
    [COLOR=darkblue]If[/COLOR] Dir(strPath, vbDirectory) = "" [COLOR=darkblue]Then[/COLOR] MkDir strPath
        
    strFileName = Range("G11").Value & Range("C11").Value
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=[COLOR=darkblue]False[/COLOR]
        
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=strPath & strFileName & ".pdf", _
                                    Quality:=xlQualityMinimum, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=[COLOR=darkblue]False[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[WERNER SLABBERT]

Using this formula to generate doc numbers but its not working exactly like i want, might generate duplicate numbers. any way to fix it a little?

=IF(B9=O4,"QUO"&10&(YEAR(C12)++M36)&SECOND(N2),IF(B9=O5,"INV"&10&(YEAR(C12)++M36)&SECOND(N2),IF(B9=O6,"JC"&10&(YEAR(C12)++M36)&SECOND(N2),IF(B9=O8,"STA"&10&(YEAR(C12)++M36)&SECOND(N2),""))))

 

[AlphaFrog]

This uses the current date-time to generate a unique number

=TEXT(NOW(),"yyyymmddhhmmss")

 

[WERNER SLABBERT]

Thank you AGAIN Alpha Frog. whole lot simpler than my initial formula.

This uses the current date-time to generate a unique number

=TEXT(NOW(),"yyyymmddhhmmss")

 

[WERNER SLABBERT]

Would it be possible for the code to create a sub folder in the current folder according to data in G11 ?

[COLOR=darkblue]Sub[/COLOR] PrintSave()
    
    [COLOR=darkblue]Dim[/COLOR] strPath [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], strFileName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    
    strPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Range("B9").Value & "\"
    [COLOR=darkblue]If[/COLOR] Dir(strPath, vbDirectory) = "" [COLOR=darkblue]Then[/COLOR] MkDir strPath
        
    strFileName = Range("G11").Value & Range("C11").Value
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=[COLOR=darkblue]False[/COLOR]
        
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=strPath & strFileName & ".pdf", _
                                    Quality:=xlQualityMinimum, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=[COLOR=darkblue]False[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[AlphaFrog]

Would it be possible for the code to create a sub folder in the current folder according to data in G11 ?

i don't know what that means.

 

[WERNER SLABBERT]

i don't know what that means.

it means that the code you provided me with creates a folder on the desktop according to the doc type, eg: invoice, quote etc. and saves the PDF to that folder using data in Cell "G11 & B9" ( modified that a little ) now to take it one step further and create a sub folder in the respective folder with a client name which is located in cell "G11"
so to clarify:what i would like to achieve if i do and quote for john smith the macro would firstly check for the folder \Quote on the desktop and then for \quote\John Smith\ and if sub folder " John Smith" does not exist create it and save the PDF there
also how can i "cut" the print function out of the macro so it does not print to a physical printer only saves the PDF copy to the desktop folders?

thank you for the help so far in this matter.

 

[AlphaFrog]

[color=darkblue]Sub[/color] SaveAsPDF()
    
    [color=darkblue]Dim[/color] strPath [color=darkblue]As[/color] [color=darkblue]String[/color], strFileName [color=darkblue]As[/color] [color=darkblue]String[/color]
    
    strPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Range("B9").Value & "\"
    [color=darkblue]If[/color] Dir(strPath, vbDirectory) = "" [color=darkblue]Then[/color] MkDir strPath
    
    strPath = strPath & Range("G11").Value & "\"
    [color=darkblue]If[/color] Dir(strPath, vbDirectory) = "" [color=darkblue]Then[/color] MkDir strPath
        
    strFileName = Range("G11").Value & Range("C11").Value
        
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:=strPath & strFileName & ".pdf", _
                                    Quality:=xlQualityMinimum, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=[color=darkblue]False[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]