[gianniskar]

Kαλημερα.Εχω το συκεκριμενο error.Δεν μπορεσα να βρω καποια ακρη ομως για να το λυσω




Public Function MakeNameFolder(ByVal sEpitheto As String, ByVal sOnoma As String) As String
Dim strname As String
If dir(strParentFolder, vbDirectory) = "" Then
MkDir strParentFolder
End If
If Len(sOnoma) * Len(sEpitheto) Then
strname = Replace(sOnoma, " ", "_") & "_" & _
Replace(sEpitheto, " ", "_")
End If
MakeNameFolder = strParentFolder & strname
End Function
Function FileExist(FileFullPath As String) As Boolean
Dim value As Boolean
value = False
If dir(FileFullPath) <> "" Then
value = True
End If
FileExist = value
End Function

Function pdfSave() As String

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

strNewFolder = MakeNameFolder 'το error ειναι εδω
strFolder = MakeNameFolder

On Error GoTo err_Hander

fileName = "Αίθουσα_Τοκετών" & "_" & Format(date, "dd-mm-yyyy")
filePath = MakeNameFolder & "\" & fileName & ".pdf"

If MakeNameFolder <> "" Then
If dir(MakeNameFolder, vbDirectory) = "" Then
MkDir MakeNameFolder
MsgBox "Δημιουργήθηκε φάκελος" & vbCrLf & strParentFolder, vbOKOnly + vbInformation, "Φάκελος Ειδικευόμενου"
End If

If FileExist(filePath) Then
answer = MsgBox("Tο αρχείο υπάρχει ήδη" & vbNewLine & filePath & vbNewLine & vbNewLine & _
"Να γίνει αντικατάσταση;", vbYesNo + vbInformation, "Αντικατάσταση")


If answer = vbNo Then
Exit Function
Else
DoCmd.OutputTo acReport, "Αίθουσα_Τοκετών", acFormatPDF, filePath
MsgBox "Το αρχείο αντικαταστάθηκε στον φάκελο " & vbCrLf & filePath, vbOKOnly + vbInformation, "Αποθήκευση αναφοράς"
Shell "EXPLORER.EXE" & " " & Chr(34) & strFolder & Chr(34), vbNormalFocus
End If

Else
DoCmd.OutputTo acReport, "Αίθουσα_Τοκετών", acFormatPDF, filePath
MsgBox "Το αρχείο αποθηκεύτηκε στον φάκελο " & vbCrLf & filePath, vbOKOnly + vbInformation, "Αποθήκευση αναφοράς"
Shell "EXPLORER.EXE" & " " & Chr(34) & strFolder & Chr(34), vbNormalFocus



End If
End If
Exit Function
err_Hander:
MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
End Function