blaksnm
Well-known Member
- Joined
- Dec 15, 2009
- Messages
- 554
- Office Version
- 365
- Platform
- Windows
Hi
I am in trouble.
When I start up Excel program two files are automaticly open (the same every time).
I have no clue how to fix this problem, but it might have a connection to a macro I used som days ago:
Reinstall MS Excel?
Please help
BR NM
The problem is to find somewhere in the macros below:
I am in trouble.
When I start up Excel program two files are automaticly open (the same every time).
I have no clue how to fix this problem, but it might have a connection to a macro I used som days ago:
Reinstall MS Excel?
Please help
BR NM
The problem is to find somewhere in the macros below:
VBA Code:
Option Explicit
Const Q As String = """"
Public Sub PDFtk_Split_PDF_By_Size()
Dim Wsh As Object 'WshShell
Dim command As String
Dim PDFinputFile As String, PDFfolder As String
Dim maxFileSizeKB As Long
Dim pageFile As String
Dim page As Long
Dim totalFileSizeKB As Single, thisFileSizeKB As Single
Dim pageFiles As String
Dim part As Long
'PDF file to be split into multiple parts
PDFinputFile = Range("FilBane").Value '"C:\!!Grane\!Håndball\Årsmelding\2021\EnkeltSider\Årsmelding 2020.pdf"
'Maximum size of each part in kilobytes
'maxFileSizeKB = 2048
Set Wsh = CreateObject("WScript.Shell") 'New WshShell
If Dir(PDFinputFile) <> vbNullString Then
PDFfolder = Left(PDFinputFile, InStrRev(PDFinputFile, "\"))
'Run PDFtk burst command to create multiple _Page_nnn.pdf files, one for each page in the input PDF
command = "cmd /c PDFtk " & Q & PDFinputFile & Q & " burst output " & Q & Replace(PDFinputFile, ".pdf", "_Page_%03d.pdf") & Q
Debug.Print Time; command
Wsh.Run command, 0, True
'Loop through the _Page_nnn.pdf files in order and create _Part_nnn.pdf files whose size is less than the maximum file size.
totalFileSizeKB = 0
pageFiles = ""
page = 0
part = 0
Do
page = page + 1
'Get the next _Page_nnn.pdf file
pageFile = Dir(Replace(PDFinputFile, ".pdf", "_Page_" & Format(page, "000") & ".pdf"))
If pageFile <> vbNullString Then
thisFileSizeKB = FileLen(PDFfolder & pageFile) / 1024
'Is this PDF page file size plus the current total file size less than the maximum file size?
If totalFileSizeKB + thisFileSizeKB <= maxFileSizeKB Then
'Yes, so add this PDF page file to the string of files and increment the current total file size
pageFiles = pageFiles & Q & PDFfolder & pageFile & Q & " "
totalFileSizeKB = totalFileSizeKB + thisFileSizeKB
Else
'No, so run PDFtk cat command to catenate the current PDF page files to the next PDF file named _Part_nnn.pdf
part = part + 1
command = "cmd /c PDFtk " & pageFiles & "cat output " & Q & Replace(PDFinputFile, ".pdf", "_Part_" & Format(part, "000") & ".pdf") & Q
Debug.Print Time; command
Wsh.Run command, 0, True
'Delete the current PDF page files
command = "cmd /c DEL " & pageFiles
Debug.Print Time; command
Wsh.Run command, 0, True
'Initialise the PDF page files with this PDF file and the total file size
pageFiles = Q & PDFfolder & pageFile & Q & " "
totalFileSizeKB = thisFileSizeKB
End If
End If
Loop Until pageFile = vbNullString
'If the current PDF page files isn't empty then run PDFtk cat command to catenate them to the next PDF file named _Part_nnn.pdf
If pageFiles <> "" Then
part = part + 1
command = "cmd /c PDFtk " & pageFiles & "cat output " & Q & Replace(PDFinputFile, ".pdf", "_Part_" & Format(part, "000") & ".pdf") & Q
Debug.Print Time; command
Wsh.Run command, 0, True
'Delete the current PDF page files
command = "cmd /c DEL " & pageFiles
Debug.Print Time; command
Wsh.Run command, 0, True
End If
'Delete doc_data.txt file created by burst command
If Dir(PDFfolder & "doc_data.txt") <> vbNullString Then Kill PDFfolder & "doc_data.txt"
MsgBox "Done"
Else
MsgBox "Error opening PDF file " & PDFinputFile
End If
Kill PDFinputFile
Range("D2").Select
ÅpneMappe
End Sub
Public Sub ExcelSaveAsPDFandMerge()
Dim FD As FileDialog
Dim file As String, p As Long
Dim Wbk As Workbook
Dim sourcePath As String, destPath As String
Dim PDFfile As String
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
With FD
.Title = "Please select the folder contains the Excel files you want to convert:"
.InitialFileName = Range("FilMappe").Value & "\" '"C:\"
If Not .Show Then Exit Sub
sourcePath = .SelectedItems.Item(1) & "\"
.Title = "Please select a destination folder to save the converted files:"
.InitialFileName = Range("FilMappe").Value & "\" '"C:\
If Not .Show Then Exit Sub
destPath = .SelectedItems.Item(1) & "\"
End With
file = Dir(sourcePath & "*.*")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While file <> vbNullString
p = InStrRev(file, ".")
Select Case LCase(Mid(file, p))
Case ".pdf"
Set Wbk = Workbooks.Open(Filename:=sourcePath & file)
PDFfile = Left(file, p - 1) & "_pdf.pdf"
Wbk.ExportAsFixedFormat Type:=xlTypePDF, Filename:=destPath & PDFfile
Wbk.Close SaveChanges:=False
End Select
file = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Merge_PDFs destPath
MsgBox "Done"
End Sub
Private Sub Merge_PDFs(PDFfolder As String)
Const Q As String = """"
Dim Wsh As Object 'WshShell
Dim inputPDFs As String, outputPDF As String
Dim PDFfile As String
Dim command As String
Dim page As Long
If Right(PDFfolder, 1) <> "\" Then PDFfolder = PDFfolder & "\"
outputPDF = PDFfolder & "All_PDFs_Merged.pdf"
If Dir(outputPDF) <> vbNullString Then Kill outputPDF
page = 1
inputPDFs = ""
Do
PDFfile = Dir(PDFfolder & "Page" & page & ".pdf")
If PDFfile <> vbNullString Then inputPDFs = inputPDFs & Q & PDFfile & Q & " "
page = page + 1
Loop While PDFfile <> vbNullString
'Merge PDFs with cat
command = "CD /D " & Q & PDFfolder & Q & " & PDFtk " & inputPDFs & " cat output " & Q & outputPDF & Q
Set Wsh = CreateObject("WScript.Shell") 'New WshShell
Wsh.Run "cmd /c " & command, 0, True
End Sub
Last edited by a moderator: