Convert MsAccess report to PDF and save it in specific customer path

[gstylianou]

Hi all,

The attached database includes an MsAccess Report and vba code so to be convert to PDF and then to stored it in a standard Path.

I would like your help so to change the standart Path with my own. Please note that:

My application has an application main folder and the Customers folder which includes many other sub-folder regarding the customer No. (exmp. C: \ Sales App \ Customers\100)

So, i need help in order to change the vba code regarding my Path (as the above example)in order to save the PDF file per selected customer into his/her own folder (C: \ Sales App \ Customers\100)

Thank you in advance

 

[Minty]

Your request is simple enough something like

  fldrPath = " C:\Sales_App\Customers\" & Me.Member_ID & "\"

But this will only work if your report was generated per customer - e.g. the button was on one detail line of your report, and the report was filtered to that single customer / member. As you report is already open this is a problem.

It would make more sense to have this on a form, and simply export the single details as a filtered report, based on the currently selected member.
You also need to check the customer specific folder exists and if not create it.

 

[gstylianou]

Your request is simple enough something like

  fldrPath = " C:\Sales_App\Customers\" & Me.Member_ID & "\"

But this will only work if your report was generated per customer - e.g. the button was on one detail line of your report, and the report was filtered to that single customer / member. As you report is already open this is a problem.

It would make more sense to have this on a form, and simply export the single details as a filtered report, based on the currently selected member.
You also need to check the customer specific folder exists and if not create it.

Thanks Minty,

I will check it and will be back

 

[gstylianou]

Thanks Minty,

I will check it and will be back

Minty i'm direct here again because of the error. Following is the real database vba code (because the attached database is an example) and the problem persist again. Note that, i call the code direct from the report (when is open) and all the data on it its correct (name, customer no etc). Really don't know what is the problem for the path.. Following is the real code:
'********************************************************************************************
Function FileExist(FileFullPath As String) As Boolean
Dim value As Boolean
value = False
If Dir(FileFullPath) <> "" Then 'the code stacks here..!!
value = True
End If
FileExist = value
End Function
'*********************************************************************************************
Private Sub cmdPrint_Click()

Dim fileName As String, fldrPath As String, filePath As String
Dim answer As Integer

fileName = "Test"
fldrPath = " C:\Program Files\Cheapsoft Medical Application\Common\Patients" & Me.CustomerNo & ""


filePath = fldrPath & "" & fileName & ".pdf"

'check if file already exists
If FileExist(filePath) Then
answer = MsgBox(prompt:="PDF file already exists: " & vbNewLine & filePath & vbNewLine & vbNewLine & _
"Would you like to replace existing file?", Buttons:=vbYesNo, Title:="Existing PDF File")
If answer = vbNo Then Exit Sub
End If

On Error GoTo invalidFolderPath
DoCmd.OutputTo objecttype:=acOutputReport, objectName:=Me.Name, outputformat:=acFormatPDF, outputFile:=filePath

MsgBox prompt:="PDF File exported to: " & vbNewLine & filePath, Buttons:=vbInformation, Title:="Report Exported as PDF"
Exit Sub

invalidFolderPath:
MsgBox prompt:="Error: Invalid folder path. Please update code.", Buttons:=vbCritical

End Sub

 

[Minty]

I'm not sure why that is failing, but see the functions I use below for folder and file checking, they definitely work.

Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
    'Purpose:   Return True if the file exists, even if it is hidden.
    'Arguments: strFile: File name to look for. Current directory searched if no path included.
    '           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
    'Note:      Does not look inside subdirectories for the file.
    'Author:    Allen Browne. http://allenbrowne.com June, 2006.
    Dim lngAttributes    As Long

    'Include read-only files, hidden files, system files.
    lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)

    If bFindFolders Then
        lngAttributes = (lngAttributes Or vbDirectory)        'Include folders as well.
    Else
        'Strip any trailing slash, so Dir does not look inside the folder.
        Do While Right$(strFile, 1) = "\"
            strFile = Left$(strFile, Len(strFile) - 1)
        Loop
    End If

    'If Dir() returns something, the file exists.
    On Error Resume Next
    FileExists = (Len(Dir(strFile, lngAttributes)) > 0)

End Function

Function FolderExists(strPath As String) As Boolean

    On Error Resume Next
    FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)


End Function


' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.

Function IsFileOpen(FileName As String)
    Dim filenum As Integer, errnum As Integer

    'Firstly check there is a file to check ;)
    If Not FileExists(FileName) Then
        IsFileOpen = False        'doesn't exist so therefore it can't be open
        Exit Function
    End If

    On Error Resume Next        ' Turn error checking off.
    filenum = FreeFile()        ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open FileName For Input Lock Read As #filenum
    Close filenum        ' Close the file.
    errnum = Err        ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
            IsFileOpen = False

            ' Error number for "Permission Denied."
            ' File is already opened by another user.
        Case 70
            IsFileOpen = True

            ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function

Get that bit working and then we can check the rest.

Edit : Actually it probably won't be working as you are missing some \ in your file path. Add this line and examine what you are getting in the immediate window.

filePath = fldrPath & "" & fileName & ".pdf"
Debug.Print filepath

 

[gstylianou]

I'm not sure why that is failing, but see the functions I use below for folder and file checking, they definitely work.

Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
    'Purpose:   Return True if the file exists, even if it is hidden.
    'Arguments: strFile: File name to look for. Current directory searched if no path included.
    '           bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
    'Note:      Does not look inside subdirectories for the file.
    'Author:    Allen Browne. http://allenbrowne.com June, 2006.
    Dim lngAttributes    As Long

    'Include read-only files, hidden files, system files.
    lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)

    If bFindFolders Then
        lngAttributes = (lngAttributes Or vbDirectory)        'Include folders as well.
    Else
        'Strip any trailing slash, so Dir does not look inside the folder.
        Do While Right$(strFile, 1) = "\"
            strFile = Left$(strFile, Len(strFile) - 1)
        Loop
    End If

    'If Dir() returns something, the file exists.
    On Error Resume Next
    FileExists = (Len(Dir(strFile, lngAttributes)) > 0)

End Function

Function FolderExists(strPath As String) As Boolean

    On Error Resume Next
    FolderExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)


End Function


' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.

Function IsFileOpen(FileName As String)
    Dim filenum As Integer, errnum As Integer

    'Firstly check there is a file to check ;)
    If Not FileExists(FileName) Then
        IsFileOpen = False        'doesn't exist so therefore it can't be open
        Exit Function
    End If

    On Error Resume Next        ' Turn error checking off.
    filenum = FreeFile()        ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open FileName For Input Lock Read As #filenum
    Close filenum        ' Close the file.
    errnum = Err        ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
            IsFileOpen = False

            ' Error number for "Permission Denied."
            ' File is already opened by another user.
        Case 70
            IsFileOpen = True

            ' Another error occurred.
        Case Else
            Error errnum
    End Select

End Function

Get that bit working and then we can check the rest.

Edit : Actually it probably won't be working as you are missing some \ in your file path. Add this line and examine what you are getting in the immediate window.

filePath = fldrPath & "" & fileName & ".pdf"
Debug.Print filepath

Minty,

Where i must put my path?
Which line i must put into immediate window?

thanks again for your time and help

 

[Minty]

Add the debug.print after your filePath = fldrPath & "" & fileName & ".pdf" line.

You will see in the immediate window (Press ctrl + G in the vba Editor) what your calculated path is.

If you get stuck post up what you currently have or zip a stripped down version of your db .

 

[gemma-the-husky]

I think you have a missing backslash between two "" characters. See the red character in the following

these lines in your code

fileName = "Test"
fldrPath = " C:\Program Files\Cheapsoft Medical Application\Common\Patients" & Me.CustomerNo & ""
filePath = fldrPath & [COLOR="Red"]"\"[/COLOR] & fileName & ".pdf"

You need a \ after the folderpath so your file is called this

C:\myfolder\test.pdf

instead of this, which will fail (or will create the file in the wrong folder)

C:\myfoldertest.pdf

The other stuff is making sure the file doesn't already exist, that it's not already open and so on, which is just bells and whistles.

 

[gstylianou]

I think you have a missing backslash between two "" characters. See the red character in the following

these lines in your code

fileName = "Test"
fldrPath = " C:\Program Files\Cheapsoft Medical Application\Common\Patients" & Me.CustomerNo & ""
filePath = fldrPath & [COLOR="Red"]"\"[/COLOR] & fileName & ".pdf"

You need a \ after the folderpath so your file is called this

C:\myfolder\test.pdf

instead of this, which will fail (or will create the file in the wrong folder)

C:\myfoldertest.pdf

The other stuff is making sure the file doesn't already exist, that it's not already open and so on, which is just bells and whistles.

Guys, attached is the modified file, do anyone help to test it?

Thanks all

 

[gstylianou]

Guys, attached is the modified file, do anyone help to test it?

Thanks all

Its crazy..!! I don't think so that the problem is something with Path because just know i test it with a simple Path like C:\Test\Patients and again i take the same error. Note, into Patients folder there is the sub-folder named 1 (customer no)

 

[Minty]

That looks okay, but you need to check the folder exists first something like ;

I realise this is testing but I would make a specific folder not in program files.

 Dim FileName As String, fldrPath As String, filePath As String
    Dim answer As Integer
    
    FileName = "Test"                     'filename for PDF file*
     fldrPath = " C:\DatabaseFiles\Patients\" & Me.CustomerNo & "\"      'folder path where pdf file will be saved *
    
'    filePath = fldrPath & "\" & FileName & ".pdf"
    filePath = fldrPath & "" & FileName & ".pdf"
    Debug.Print filePath
    
    [COLOR="Red"]If Not FolderExists(fldrPath) Then
        MkDir fldrPath
    End If[/COLOR]
    'check if file already exists
    If FileExists(filePath) Then
        answer = MsgBox(prompt:="PDF file already exists: " & vbNewLine & filePath & vbNewLine & vbNewLine & _
                        "Would you like to replace existing file?", buttons:=vbYesNo, Title:="Existing PDF File")
        If answer = vbNo Then Exit Sub
    End If
    
    On Error GoTo invalidFolderPath
    DoCmd.OutputTo objecttype:=acOutputReport, objectName:=Me.Name, outputformat:=acFormatPDF, outputFile:=filePath
    
    MsgBox prompt:="PDF File exported to: " & vbNewLine & filePath, buttons:=vbInformation, Title:="Report Exported as PDF"
    Exit Sub

 

[gstylianou]

That looks okay, but you need to check the folder exists first something like ;

I realise this is testing but I would make a specific folder not in program files.

 Dim FileName As String, fldrPath As String, filePath As String
    Dim answer As Integer
    
    FileName = "Test"                     'filename for PDF file*
     fldrPath = " C:\DatabaseFiles\Patients\" & Me.CustomerNo & "\"      'folder path where pdf file will be saved *
    
'    filePath = fldrPath & "\" & FileName & ".pdf"
    filePath = fldrPath & "" & FileName & ".pdf"
    Debug.Print filePath
    
    [COLOR="Red"]If Not FolderExists(fldrPath) Then
        MkDir fldrPath
    End If[/COLOR]
    'check if file already exists
    If FileExists(filePath) Then
        answer = MsgBox(prompt:="PDF file already exists: " & vbNewLine & filePath & vbNewLine & vbNewLine & _
                        "Would you like to replace existing file?", buttons:=vbYesNo, Title:="Existing PDF File")
        If answer = vbNo Then Exit Sub
    End If
    
    On Error GoTo invalidFolderPath
    DoCmd.OutputTo objecttype:=acOutputReport, objectName:=Me.Name, outputformat:=acFormatPDF, outputFile:=filePath
    
    MsgBox prompt:="PDF File exported to: " & vbNewLine & filePath, buttons:=vbInformation, Title:="Report Exported as PDF"
    Exit Sub

Today really i will be crazy..!!!
Again problem with Path..! Already i have the main folder on C:\DatabaseFiles\Patients and i'm getting error..!! Please, is it possible to modify my last attached file?


Private Sub Command24_Click()
Dim FileName As String, fldrPath As String, filePath As String
Dim answer As Integer

FileName = "Test" 'filename for PDF file*
fldrPath = " C:\DatabaseFiles\Patients" & Me.CustomerNo & "" 'folder path where pdf file will be saved *

' filePath = fldrPath & "" & FileName & ".pdf"
filePath = fldrPath & "" & FileName & ".pdf"
Debug.Print filePath

If Not FolderExists(fldrPath) Then
MkDir fldrPath
End If
'check if file already exists
If FileExists(filePath) Then
answer = MsgBox(prompt:="PDF file already exists: " & vbNewLine & filePath & vbNewLine & vbNewLine & _
"Would you like to replace existing file?", buttons:=vbYesNo, Title:="Existing PDF File")
If answer = vbNo Then Exit Sub
End If

' On Error GoTo invalidFolderPath
' DoCmd.OutputTo objecttype:=acOutputReport, objectName:=Me.Name, outputformat:=acFormatPDF, outputFile:=filePath

MsgBox prompt:="PDF File exported to: " & vbNewLine & filePath, buttons:=vbInformation, Title:="Report Exported as PDF"
Exit Sub
End Sub

 

[gstylianou]

Just for testing i make as comment the MkDir fldrPath line. After that i 'm getting the message that the PDF file was created into the specific folder....but......there is no pdf file into this folder..!!!




Private Sub Command24_Click()
Dim FileName As String, fldrPath As String, filePath As String
Dim answer As Integer

FileName = "Test" 'filename for PDF file*
fldrPath = " C:\DatabaseFiles\Patients" & Me.CustomerNo & "" 'folder path where pdf file will be saved *

' filePath = fldrPath & "" & FileName & ".pdf"
filePath = fldrPath & "" & FileName & ".pdf"
Debug.Print filePath

' If Not FolderExists(fldrPath) Then
' MkDir fldrPath
' End If

'check if file already exists
If FileExists(filePath) Then
answer = MsgBox(prompt:="PDF file already exists: " & vbNewLine & filePath & vbNewLine & vbNewLine & _
"Would you like to replace existing file?", buttons:=vbYesNo, Title:="Existing PDF File")
If answer = vbNo Then Exit Sub
End If

' On Error GoTo invalidFolderPath
' DoCmd.OutputTo objecttype:=acOutputReport, objectName:=Me.Name, outputformat:=acFormatPDF, outputFile:=filePath

MsgBox prompt:="PDF File exported to: " & vbNewLine & filePath, buttons:=vbInformation, Title:="Report Exported as PDF"
Exit Sub
End Sub

 

[gemma-the-husky]

FileName = "Test" 'filename for PDF file*
fldrPath = " C:\DatabaseFiles\Patients" & Me.CustomerNo & "" 'folder path where pdf file will be saved *

' filePath = fldrPath & "" & FileName & ".pdf"
filePath = fldrPath &[COLOR="Red"] ""[/COLOR] & FileName & ".pdf"
Debug.Print filePath

just to repeat - I am pretty sure your problem is caused by the red "" characters. I do not think they are necessary, and I think they are making your output either fail, or go to a different folder.

 

[Minty]

You have commented out the create pdf part of your code ' DoCmd.OutputTo !

 

[gstylianou]

You have commented out the create pdf part of your code ' DoCmd.OutputTo !

Yes because i was tried to test it. If you cancel the comments again you get the relative error...

(what a f.......day..!!)

 

[gstylianou]

Now, after the below modifications, i'm getting the correct message that the new PDF file was created on the correct Path (C:\DatabaseFiles\Patients\1\Test.pdf) but the file isn't there and i get the attached error..! Any new ideas?

Private Sub Command24_Click()
Dim FileName As String, fldrPath As String, filePath As String
Dim answer As Integer

FileName = "Test" 'filename for PDF file*
fldrPath = " C:\DatabaseFiles\Patients" & Me.CustomerNo & "" 'folder path where pdf file will be saved *

' filePath = fldrPath & "" & FileName & ".pdf"
' filePath = fldrPath & "" & FileName & ".pdf"

filePath = fldrPath & "" & FileName & ".pdf"
Debug.Print filePath

' If Not FolderExists(fldrPath) Then
' MkDir fldrPath
' End If

'check if file already exists
If FileExists(filePath) Then
answer = MsgBox(prompt:="PDF file already exists: " & vbNewLine & filePath & vbNewLine & vbNewLine & _
"Would you like to replace existing file?", buttons:=vbYesNo, Title:="Existing PDF File")
If answer = vbNo Then Exit Sub
End If

' On Error GoTo invalidFolderPath
DoCmd.OutputTo objecttype:=acOutputReport, objectName:=Me.Name, outputformat:=acFormatPDF, outputFile:=filePath

MsgBox prompt:="PDF File exported to: " & vbNewLine & filePath, buttons:=vbInformation, Title:="Report Exported as PDF"
Exit Sub
End Sub

 

[Minty]

What does Me.Name resolve to?
E.g. Add
Debug.Print Me.Name
to your code before that line.

 

[gstylianou]

What does Me.Name resolve to?
E.g. Add
Debug.Print Me.Name
to your code before that line.

100% something much crazy..!!!!! Have a look to the attached pic.

 

[gemma-the-husky]

DoCmd.OutputTo objecttype:=acOutputReport, objectName:=Me.Name, outputformat:=acFormatPDF, outputFile:=filePath


1. I am not sure about the red expression. May be correct, but may not.

More likely
2. You would get error 2501 if the report failed because of an error in the query. It's a generic "did not work" indicator. does the report open if you just try it outside this code block?