Saving a pdf report by selecting a location (1 Viewer)

[Sam Summers]

Hi guys,

I am nearly there with this but cant quite get the last bit done.

The two separate sections work i.e. the file location opens and the file save section works well too but I want to allow the user to simply choose the location for the file as named already.

Private Sub TOMainPdf_Click()
On Error GoTo TOMainPdf_Click_Err

Dim MyPath As String
Dim MyFilename As String

Dim f As Object
Set f = Application.FileDialog(msoFileDialogFilePicker)
Dim varFile As Variant
f.Show
With f
    .AllowMultiSelect = False
     For Each varFile In .SelectedItems
        MsgBox varFile
     Next varFile
End With

Me.JobNo.SetFocus

MyPath = "C:\Users\Sam Summers\Documents\Work Databases\Hatch\"
MyFilename = Me.JobNo.Text & "-" & "Transocean Main Rpt" & "-" & Day(Now) & "-" & Month(Now) & "-" & Year(Now) & ".pdf"

DoCmd.OutputTo acOutputReport, "TransoceanMainRpt", acFormatPDF, MyPath & MyFilename, False


TOMainPdf_Click_Exit:
    Exit Sub

TOMainPdf_Click_Err:
    MsgBox Error$
    Resume TOMainPdf_Click_Exit

End Sub

Many thanks in advance

 

[Ranman256]

  ''starting here with your code 
MyPath = "C:\Users\Sam Summers\Documents\Work Databases\Hatch\"
vPath = UserSaveDir (myPath)
getDirName vPath, MyPath, f
 MyFilename = Me.JobNo.Text & "-" & "Transocean Main Rpt" & "-" & Day(Now) & "-" & Month(Now) & "-" & Year(Now) & ".pdf"
 DoCmd.OutputTo acOutputReport, "TransoceanMainRpt", acFormatPDF, MyPath & MyFilename, False
 
TOMainPdf_Click_Exit:
    Exit Sub
 TOMainPdf_Click_Err:
    MsgBox Error$
    Resume TOMainPdf_Click_Exit
End Sub
  
 '---------------
Public Function UserSaveDir(Optional pvPath)
'---------------
Dim strTable As String
Dim strFilePath As String
Dim sDialog As String, sDecr  As String, sExt As String
 '===================
'YOU MUST ADD REFERENCE : Microsoft Office xx.0 Object Library, in vbe menu, TOOLS, REFERENCES
'===================
With Application.FileDialog(msoFileDialogSaveAs)
    .AllowMultiSelect = False
    .Title = "Save file"
    .ButtonName = "Save As"
    '.Filters.Clear
    '.Filters.Add "All Files", "*.*"
    .InitialFileName = pvPath
    .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail
    
    UserSaveDir= .Show
End With
End Function
 
'given filepath, passes back: Dir name , filename
'---------------
Public Sub getDirName(ByVal psFilePath, ByRef prvDir, Optional ByRef prvFile)
'---------------
    'psFilePath: full file path given
    'prvDir : directory name output
    'prvFile: filename only output
Dim i As Integer, sDir As String
 i = InStrRev(psFilePath, "\")          'not available in '97
If i > 0 Then
  prvDir = Left(psFilePath, i)
  prvFile = Mid(psFilePath, i + 1)
End If
End Sub

 

[Sam Summers]

Hi Ranman,

I have been playing about with it to get it working and it nearly does.

The save file window comes up with the pdf filename but the save as section is 'all files' and when you click on save as, the file is not saved?

Here is the code I have:

Private Sub TOMainPdf_Click()
On Error GoTo TOMainPdf_Click_Err

Dim MyPath As String
Dim MyFileName As String
Dim dlgSaveAs As FileDialog
 Dim strFilePath As String
 Dim strFileName As String
 Dim GetSaveFileName As String

Me.JobNo.SetFocus

    Dim Dialog As FileDialog
    Set Dialog = Application.FileDialog(msoFileDialogSaveAs)
    With Dialog
        .InitialFileName = Me.JobNo.Text & "-" & "Transocean Main Rpt" & "-" & Day(Now) & "-" & Month(Now) & "-" & Year(Now) & ".pdf"
        .FilterIndex = 2
        .Title = "Save As"
        If .Show <> 0 Then
            GetSaveFileName = .SelectedItems(1)
        End If
        'DoCmd.OutputTo acOutputReport, "TransoceanSubSectionRpt", acFormatPDF, MyPath & MyFileName, False
    End With
    

TOMainPdf_Click_Exit:
    Exit Sub

TOMainPdf_Click_Err:
    MsgBox Error$
    Resume TOMainPdf_Click_Exit

End Sub
  
 '---------------
Public Function UserSaveDir(Optional pvPath)
'---------------
Dim strTable As String
Dim strFilePath As String
Dim sDialog As String, sDecr  As String, sExt As String

With Application.FileDialog(msoFileDialogSaveAs)
    .AllowMultiSelect = False
    .Title = "Save file"
    .ButtonName = "Save As"
    .InitialFileName = pvPath
    .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail
    
    UserSaveDir = .Show
End With
End Function
 
'given filepath, passes back: Dir name , filename
'---------------
Public Sub getDirName(ByVal psFilePath, ByRef prvDir, Optional ByRef prvFile)
'---------------

Dim i As Integer, sDir As String
 i = InStrRev(psFilePath, "\")          'not available in '97
If i > 0 Then
  prvDir = Left(psFilePath, i)
  prvFile = Mid(psFilePath, i + 1)
End If
End Sub

 

[Ranman256]

the dialog returns the full path/file name the user entered.
but you don't want that,
you want YOUR file, but their path, so when user picks a file , I use
getDirName , to strip out the folder name
then attach your filename to it.

 

[Sam Summers]

Yes that right

 

[Sam Summers]

I cant get this to work at the moment.

Its beyond my level

 

[Minty]

This may sound a bit draconian, but you might be better saving the files in a fixed network location, that is backed up and available for all to see.
You can then store this location is a system table and look it up - so that if you ever need to change it, you only change the location in one place - the system table field holding your file save location.
This also would mean you could check if the report had already been saved by anybody that day and give them the option to review it or overwrite it ?

 

[Sam Summers]

I know what you mean Minty.

This particular little DB will only be installed on individual laptops to be used for an inspection and then once the reports are completed and filed the DB will be emptied ready for the next inspection.

I have already created a pdf save button with a file location hard coded and this works fine but I thought it might be slicker to give someone the option to save somewhere of their choice?

But otherwise I will use my current functioning method which works great

 

[Cronk]

Sam

You are getting off the rails when you use msoFileDialogFilePicker. You want to select a folder, not a file.

Try this
function SelectFolder(Optional MyDefaultFolder as string) as string
with application.filedialog(msoFileDialogFolderPicker)
.initialfileName = MyDefaultFolder
.allowmultiselect =False
.Show
.SelectFolder=.selectedItems(1)
.end with
end function

 

[Sam Summers]

Hi Cronk, and thank you to everybody but I couldn't get any of it to work. Nearly but not quite. Its beyond my current ability so I have settled for this and I will have to hard code in the location everytime prior to deploying the DB

Private Sub TOMainPdf_Click()
On Error GoTo TOMainPdf_Click_Err

Dim MyPath As String
Dim MyFileName As String

MyPath = "C:\Users\Sam Summers\Documents\Work Databases\Hatch\"

 Me.JobNo.SetFocus
 MyFileName = Me.JobNo.Text & "-" & "Transocean Main Rpt" & "-" & Day(Now) & "-" & Month(Now) & "-" & Year(Now) & ".pdf"
 DoCmd.OutputTo acOutputReport, "TransoceanMainRpt", acFormatPDF, MyPath & MyFileName, False

TOMainPdf_Click_Exit:
    Exit Sub

TOMainPdf_Click_Err:
    MsgBox Error$
    Resume TOMainPdf_Click_Exit

End Sub

 

[Minty]

If you want to use the database path on the users machine you can get it from

    Dim sAppath as String
    sAppPath = CurrentProject.path

Which means you don't need to hard code it.

 

[Sam Summers]

Hi again Minty,

I have continued trying a few things and came across the code below at https://bytes.com/topic/access/answers/886621-output-report-pdf-format-save-send-email

Private Sub TOMainPdf_Click()
On Error GoTo TOMainPdf_Click_Err

Dim MyFileName As String
Dim fd As FileDialog
Dim strFolder As String

 Me.JobNo.SetFocus
 MyFileName = Me.JobNo.Text & "-" & "Transocean Main Rpt" & "-" & Day(Now) & "-" & Month(Now) & "-" & Year(Now) & ".pdf"
 
 Set fd = Application.FileDialog(msoFileDialogFolderPicker)

 If fd.Show = -1 Then
     strFolder = fd.SelectedItems.Item(1)
 Else
     Exit Sub
 End If

 DoCmd.OutputTo acOutputReport, "TransoceanMainRpt", acFormatPDF, strFolder & MyFileName, False

 Set fd = Nothing


TOMainPdf_Click_Exit:
    Exit Sub

TOMainPdf_Click_Err:
    MsgBox Error$
    Resume TOMainPdf_Click_Exit

End Sub

Which works well apart from it doesn't save it where I select but it does one folder above and I don't understand the code to figure out why?

 

[Minty]

Which works well apart from it doesn't save it where I select but it does one folder above and I don't understand the code to figure out why?

What does a Debug.Print of strFolder show you compared with what you clicked on ??

 

[Sam Summers]

I'm not quite sure how to use the Debug.Print but this is what I tried.

What opens up is the folder that has the folder where I want to place it (Hatch) in it, but when I open the Hatch folder and click OK, my pdf is saved in the Work Databases folder?

Private Sub TOMainPdf_Click()
On Error GoTo TOMainPdf_Click_Err

Dim MyFileName As String
Dim fd As FileDialog
Dim strFolder As String

 Me.JobNo.SetFocus
 MyFileName = Me.JobNo.Text & "-" & "Transocean Main Rpt" & "-" & Day(Now) & "-" & Month(Now) & "-" & Year(Now) & ".pdf"
 
 Set fd = Application.FileDialog(msoFileDialogFolderPicker)

 If fd.Show = -1 Then
     strFolder = fd.SelectedItems.Item(1)
 Else
     Exit Sub
 End If
Debug.Print strFolder
 DoCmd.OutputTo acOutputReport, "TransoceanMainRpt", acFormatPDF, strFolder & MyFileName, False

 Set fd = Nothing


TOMainPdf_Click_Exit:
    Exit Sub

TOMainPdf_Click_Err:
    MsgBox Error$
    Resume TOMainPdf_Click_Exit

End Sub

 

[Minty]

While your form is open keep the VBA window open you will see in the Immediate window (Press Ctrl G to bring it up) the result of any debug.print statements that are fired.
It is by far the most useful debugging tool - get into the habit of using it to see what your code values actually are !

 

[Sam Summers]

that's great Minty!

I will use that from now on!

Ok, well strangely enough it displays: C:\Users\Sam Summers\Documents\Work Databases\Hatch

but the file is being saved in C:\Users\Sam Summers\Documents\Work Databases ??

 

[Minty]

Have you tried adding a \ to the path it returns

 

[Sam Summers]

Where do I put that in this?

Private Sub TOMainPdf_Click()
On Error GoTo TOMainPdf_Click_Err

Dim MyFileName As String
Dim fd As FileDialog
Dim strFolder As String

 Me.JobNo.SetFocus
 MyFileName = Me.JobNo.Text & "-" & "Transocean Main Rpt" & "-" & Day(Now) & "-" & Month(Now) & "-" & Year(Now) & ".pdf"
 
 Set fd = Application.FileDialog(msoFileDialogFolderPicker)

 If fd.Show = -1 Then
     strFolder = fd.SelectedItems.Item(1)
 Else
     Exit Sub
 End If
Debug.Print strFolder
 DoCmd.OutputTo acOutputReport, "TransoceanMainRpt", acFormatPDF, strFolder & MyFileName, False

 Set fd = Nothing


TOMainPdf_Click_Exit:
    Exit Sub

TOMainPdf_Click_Err:
    MsgBox Error$
    Resume TOMainPdf_Click_Exit

End Sub

 

[Minty]

See below in red - and see that I reprint the debug so I can see works.

Private Sub TOMainPdf_Click()
On Error GoTo TOMainPdf_Click_Err

Dim MyFileName As String
Dim fd As FileDialog
Dim strFolder As String

 Me.JobNo.SetFocus
 MyFileName = Me.JobNo.Text & "-" & "Transocean Main Rpt" & "-" & Day(Now) & "-" & Month(Now) & "-" & Year(Now) & ".pdf"
 
 Set fd = Application.FileDialog(msoFileDialogFolderPicker)

 If fd.Show = -1 Then
     strFolder = fd.SelectedItems.Item(1)
 Else
     Exit Sub
 End If
 Debug.Print strFolder
[COLOR="Red"] strFolder = strFolder & "\"
 Debug.Print strFolder[/COLOR]
 DoCmd.OutputTo acOutputReport, "TransoceanMainRpt", acFormatPDF, strFolder & MyFileName, False

 Set fd = Nothing


TOMainPdf_Click_Exit:
    Exit Sub

TOMainPdf_Click_Err:
    MsgBox Error$
    Resume TOMainPdf_Click_Exit

End Sub

 

[Sam Summers]

Yep we got it!!!!

Thank you so much