Folder Picker Problems

Question

I seem to be having an issue with a some VBA code that I wrote.  It will create a PDF of the selected worksheet, naming it based on some predefined criteria.  It creates the PDF just fine.  The problem is that if I choose a folder to save it to, it saves it to one folder up from that.  So if I choose C:\My Documents\My Stuff it will save it to C:\My Documents.  Any thoughts?

Here's the code for the Folder Picker sections:

Function GetSaveToFolder() As String

' Delcare a variable as a FileDialog Object

Dim fd As fileDialog

Dim newFolder As String

GetSaveToFolder = ""

' Create a FileDialog object as a File Picker Dialog box

Set fd = Application.fileDialog(msoFileDialogFolderPicker)

' Use a With...End With block to reference the FileDialog object.

With fd

' Use the show method to display the file picker dialog box and return the user's action.

' The user pressed the action button.

If .Show = -1 Then

GetSaveToFolder = .SelectedItems(1)

' at this time, the path does not have a "" at the end of it

' rather than just adding one on to it, we test to see if it is there

' and if not, then add it

' This keeps it working if they ever change the way

' the folder picker works

If Right(GetSaveToFolder, 1) <> Application.PathSeparator Then

GetSaveToFolder = GetSaveToFolder & Application.PathSeparator

End If

Else

' the user pressed cancel

End If

End With

' set the object variable to Nothing

Set fd = Nothing

End Function

Harlan

Answer 1

You assemble newFileName, including folderPath, before assigning a value to folderPath. At that point, folderPath is an empty string "".

You assign a value to folderPath later on, but you don't use it for anything.

You should move

folderPath = GetSaveToFolder()

up to before you use it in

newFileName = folderPath & entityName & " - "

Answer 2

PLesae check at

sheetToPrint.ExportAsFixedFormat Line

Answer 3

Ok.  I can't figure this out.  I've stepped through the whole thing, and everything seems to look fine, but when it does finally save it saves to the folder immediately preceeding the folder I pick.  Not sure why.  

Here's the code for the SaveToPDF:

Public Sub PrintToPDF(control As IRibbonControl)

' used to easily save and name the selected  sheet to a PDF

' depending on the active sheet and the information available on that sheet.

Dim folderPath As String

Dim newFileName As String

Dim currentLocationAndName As String

Dim fd As fileDialog

Dim sheetToPrint As Worksheet

Dim workbookName As String

Dim workbookPath As String

Dim refWS As Worksheet

Dim entityName As String

Const pdfExt = ".pdf"

currentLocationAndName = ThisWorkbook.FullName

If InStr(currentLocationAndName, "") = 0 Then

MsgBox "You must first save this file to disk before you can save as PDF", _

vbOKOnly + vbCritical, "File Not Save"

Exit Sub

End If

' create a new name for the pdf file

' would be based on active sheet name and type info

Set sheetToPrint = ThisWorkbook.activeSheet

' Grab the entity name from the Instructions sheet

Set refWS = ThisWorkbook.Worksheets(instructionSheetName)

entityName = refWS.Range(entityNameCell).Value

Set refWS = Nothing

' Create the path

newFileName = folderPath & entityName & " - "

' add the SELECT CASE structure here to find the relevant

' information for each sheet type

' add to the newFileName

Select Case sheetToPrint.Name

Case Is = dailyName

newFileName = newFileName & ReturnSingleDate(sheetToPrint) & pdfExt

Case Is = balanceSummary

newFileName = newFileName & ReturnSingleDate(sheetToPrint) & pdfExt

Case Is = balanceDetailed

newFileName = newFileName & ReturnSingleDate(sheetToPrint) & pdfExt

Case Is = periodSummaryName

newFileName = newFileName & ReturnSingleYear(sheetToPrint) & pdfExt

Case Is = periodBudgetName

newFileName = newFileName & ReturnSingleYear(sheetToPrint) & pdfExt

Case Is = investorName

newFileName = newFileName & ReturnSingleYear(sheetToPrint) & pdfExt

Case Is = budgetSheetName

newFileName = newFileName & ReturnSingleYear(sheetToPrint) & pdfExt

Case Is = eopSheetName

newFileName = newFileName & ReturnPeriodAndYear(sheetToPrint) & pdfExt

Case Is = midPeriodName

newFileName = newFileName & ReturnPeriodAndYear(sheetToPrint) & pdfExt

Case Is = plSheetName

newFileName = newFileName & ReturnSheetAndDateRange(sheetToPrint) & pdfExt

Case Is = weeklySheetName

newFileName = newFileName & ReturnSheetAndDateRange(sheetToPrint) & pdfExt

Case Else

' do nothing

End Select

' Test to see if the Microsoft Create/ Send Add-In is Installed

If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _

& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

' Open the Folder Picker Dialog Box

folderPath = GetSaveToFolder()

If folderPath = "" Then

Exit Sub

End If

End If

' does the file already exist?

If Dir(newFileName) <> "" Then

If MsgBox("File: " & vbCrLf & newFileName & vbCrLf & _

"Already Exists.  Overwrite it?", vbYesNoCancel + vbExclamation, _

"File Exists") <> vbYes Then

Exit Sub

End If

End If

On Error Resume Next

sheetToPrint.ExportAsFixedFormat Type:=xlTypePDF, _

fileName:=newFileName, Quality:=xlQualityStandard, _

IncludeDocProperties:=True, IgnorePrintAreas:=False, _

OpenAfterPublish:=False

If Err <> 0 Then

MsgBox "There was an unexpected error writing the .pdf file:" & vbCrLf _

& Err.Number & " " & Err.Description, vbOKOnly + vbCritical, "PDF Write Error"

Err.Clear

Else

MsgBox "File:" & vbCrLf & newFileName & vbCrLf & "Has been written.", _

vbOKOnly + vbInformation, "PDF File Successfully Written"

End If

On Error GoTo 0

End Sub

Answer 4

Yeah I just tested it by itself also.  Which means it has something to do with the code to create the PDF.  Let me see if I can figure it out.

Answer 5

Your code works correctly when I run it.

Are you sure you actually select a folder? If you open a folder in the folder picker dialog, then click OK without selecting a subfolder, it'll return the folder that you opened, not one of the subfolders.