Forum

Forum (https://www.ms-office.gr/forum/)
-   Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)
-   -   πολλα pdf σε ενα pdf (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/6365-polla-pdf-se-ena-pdf.html)

pakos 15-09-23 15:28

πολλα pdf σε ενα pdf
 
1 Συνημμένο(α)
χαιρετω τα μελη

εχω εναν κωδικα σε ενα αρχειο της access που κανει ολα pdf ενος φακελου σε ενα pdf
μεχρι εδω καλα ολα δουλευουν τελεια στη συγκεκριμενη εφαρμογη

οταν εβαλα τον ιδιο κωδικα σε ενα αλλο αρχειο της access εχω προβλημα
βγαζει το παρακατω μηνυμα

Wrong number of arguments or invalid property assignment

τα references ειναι ιδια.


παρακατω ο κωδικας


Sub Main()
Const DestFile As String = "ΟΛA.PDF" ' <-- Το αρχειο που θα δημιουργηθεί
Dim MyPath As String, MyFiles As String
Dim a() As String, i As Long, f As String

MyPath = ("C:\ΑΡΧΕΙΑ\PDF\ΞΕΝΟΔΟΧΕΙΟ")

' Populate the array a() by PDF file names
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
ReDim a(1 To 2 ^ 14)
f = Dir(MyPath & "*.pdf")
While Len(f)
If StrComp(f, DestFile, vbTextCompare) Then
i = i + 1
a(i) = f
End If
f = Dir()
Wend

' Merge PDFs
If i Then
ReDim Preserve a(1 To i)
MyFiles = Join(a, ",")
'Application.StatusBar = "Merging, please wait ..."
Call MergePDFs20(MyPath, MyFiles, DestFile)
'Application.StatusBar = False
Else
MsgBox "No PDF files found in" & vbLf & MyPath, vbExclamation, "Canceled"
End If

Call Rename

End Sub
================================================== ========================

Sub MergePDFs20(MyPath As String, MyFiles As String, Optional DestFile As String = "MergedFile.pdf")
' ZVI:2013-08-27 [SOLVED] Need code to merge PDF files in a folder using adobe acrobat X
' Reference required: VBE - Tools - References - Acrobat

Dim a As Variant, i As Long, n As Long, ni As Long, p As String
Dim AcroApp As New Acrobat.AcroApp, PartDocs() As Acrobat.CAcroPDDoc

If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"
a = Split(MyFiles, ",") <------------------------------------------------------------------------------------ προβλημα
ReDim PartDocs(0 To UBound(a))

On Error GoTo exit_
If Len(Dir(p & DestFile)) Then Kill p & DestFile
For i = 0 To UBound(a)
' Check PDF file presence
If Dir(p & Trim(a(i))) = "" Then
' MsgBox "File not found" & vbLf & p & a(i), vbExclamation, "Canceled"
Exit For
End If
' Open PDF document
Set PartDocs(i) = CreateObject("AcroExch.PDDoc")
PartDocs(i).Open p & Trim(a(i))
If i Then
' Merge PDF to PartDocs(0) document
ni = PartDocs(i).GetNumPages()
If Not PartDocs(0).InsertPages(n - 1, PartDocs(i), 0, ni, True) Then
' MsgBox "Cannot insert pages of" & vbLf & p & a(i), vbExclamation, "Canceled"
End If
' Calc the number of pages in the merged document
n = n + ni
' Release the memory
PartDocs(i).Close
Set PartDocs(i) = Nothing
Else
' Calc the number of pages in PartDocs(0) document
n = PartDocs(0).GetNumPages()
End If
Next

If i > UBound(a) Then
' Save the merged document to DestFile
If Not PartDocs(0).Save(PDSaveFull, p & DestFile) Then
' MsgBox "Cannot save the resulting document" & vbLf & p & DestFile, vbExclamation, "Canceled"
End If
End If

exit_:

' Inform about error/success
If Err Then
' MsgBox Err.Description, vbCritical, "Error #" & Err.Number
ElseIf i > UBound(a) Then
' MsgBox "The resulting file is created:" & vbLf & p & DestFile, vbInformation, "Done"
End If
' Release the memory
If Not PartDocs(0) Is Nothing Then PartDocs(0).Close
Set PartDocs(0) = Nothing

' Quit Acrobat application
AcroApp.Exit
Set AcroApp = Nothing

'

End Sub
================================================== ======================




Sub Rename()

Dim filePath As String
Dim newFilePath As String

filePath = "C:\ΑΡΧΕΙΑ\PDF\ΞΕΝΟΔΟΧΕΙΟ\" & "ΟΛA" & ".PDF"
newFilePath = "C:\ΑΡΧΕΙΑ\PDF\ΞΕΝΟΔΟΧΕΙΟ\"& ονομασιαΑρχειουΣυμφωναΜεΤ ηνΦορμα & ".PDF"
Name filePath As newFilePath
End Sub

================================


εδω κτυπαει ο κωδικας

If Right(MyPath, 1) = "\" Then p = MyPath Else p = MyPath & "\"
a = Split(MyFiles, ",") <------------------------------------------------------------------------------------
ReDim PartDocs(0 To UBound(a))

pakos 17-09-23 08:55

συνεχεια
 
για ενημερωση ο κωδικας ειναι οκ
απλα ειχα καποιο κωδικα με το ονομα split και για τον λογω αυτο δημιουργουσε το προβλημα


Η ώρα είναι 09:43.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2