[VBA] Update code to create folder and save docs within

[sprigelz]

Below is some of the code from a VBA macro. Currently when this runs it saves all newly created docs directly onto the desktop. Instead I would like for this code to create a named folder onto the desktop and save the files within.

DesktopFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"

Could you help please.

 

[Kenneth Hobson]

Change value of sfs. Last 2 lines in sub are for testing. Change those to suit.

Sub SubFoldersInDesktop()
  Dim DesktopFolder As String, sfs As String
  
  sfs = "Named Folder\Sub1\Sub2"
  With CreateObject("WScript.Shell")
    DesktopFolder = .SpecialFolders("Desktop") & "\"
    sfs = DesktopFolder & sfs
    .Run "cmd /c md " & """" & sfs & """", 0, True
  End With
  
  FileCopy "d:\t\test.txt", sfs & "\test.txt"
  Shell "explorer " & """" & sfs & """", vbNormalFocus
End Sub

 

[sprigelz]

Kenneth, thanks for the code. It created the folder, but did not save the files within. Below is the full code. Is there something else I need to change?

Public Sub Create_PDFs()

    Dim DesktopFolder As String, sfs As String
    Dim r As Range
   
    sfs = "Named Folder"
    With CreateObject("WScript.Shell")
    DesktopFolder = .SpecialFolders("Desktop") & "\"
    sfs = DesktopFolder & sfs
    .Run "cmd /c md " & """" & sfs & """", 0, True
    End With
   
    For Each r In Range(Range("K3").Validation.Formula1)
        Range("K3").Value = r.Value
        Sheets("Letter").ExportAsFixedFormat _
            Type:=xlTypePDF, Filename:=DesktopFolder & Sheets("Letter").Range("K3").Value & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next

End Sub

 

[Kenneth Hobson]

You saved the pdfs to the desktopfolder and not sfs folder. r could be blank or be data with illegal filename characters.

Maybe something like:

'Sheets("Letter").ExportAsFixedFormat _
            Type:=xlTypePDF, Filename:=DesktopFolder & Sheets("Letter").Range("K3").Value & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Letter").ExportAsFixedFormat _
            Type:=xlTypePDF, Filename:=sfs & "\" & r & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

 

[sprigelz]

You saved the pdfs to the desktopfolder and not sfs folder. r could be blank or be data with illegal filename characters.

Maybe something like:

'Sheets("Letter").ExportAsFixedFormat _
            Type:=xlTypePDF, Filename:=DesktopFolder & Sheets("Letter").Range("K3").Value & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Sheets("Letter").ExportAsFixedFormat _
            Type:=xlTypePDF, Filename:=sfs & "\" & r & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Absolutely perfect. Thank you!