| Access - Ερωτήσεις / Απαντήσεις Access + VBA... Εδώ δεν υπάρχουν όρια! |
| | Εργαλεία Θεμάτων | Τρόποι εμφάνισης |
|
#1
| |||
| |||
|
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 |
« Προηγούμενο Θέμα
|
Επόμενο Θέμα »
| |
Η ώρα είναι 09:21.



Θεματικός Τρόπος