11468

Similar VBScript for converting Excel and PowerPoint to PDF

Question:

I am looking for a completely lossless way of converting Excel and PowerPoint documents to PDF. I am using this script for Word and it works flawlessly <a href="https://gallery.technet.microsoft.com/office/Script-to-convert-Word-08c5154b" rel="nofollow">https://gallery.technet.microsoft.com/office/Script-to-convert-Word-08c5154b</a>. I am looking for a similar script for Excel and PowerPoint and cant find one on the internet. I dont have much experience with VB at all so I am confused where it specifies which office application to use. Is there anyone that can provide one for Excel and PowerPoint or someone proficient in VB that would be able to change the script to work with the other packages? I assume its just changing the intent as the programs integrated save as PDF option is the same?

The script for Word is below as well:

Option Explicit '################################################ 'This script is to convert Word documents to PDF files '################################################ Sub main() Dim ArgCount ArgCount = WScript.Arguments.Count Select Case ArgCount Case 1 MsgBox "Please ensure Word documents are saved,if that press 'OK' to continue",,"Warning" Dim DocPaths,objshell DocPaths = WScript.Arguments(0) StopWordApp Set objshell = CreateObject("scripting.filesystemobject") If objshell.FolderExists(DocPaths) Then 'Check if the object is a folder Dim flag,FileNumber flag = 0 FileNumber = 0 Dim Folder,DocFiles,DocFile Set Folder = objshell.GetFolder(DocPaths) Set DocFiles = Folder.Files For Each DocFile In DocFiles 'loop the files in the folder FileNumber=FileNumber+1 DocPath = DocFile.Path If GetWordFile(DocPath) Then 'if the file is Word document, then convert it ConvertWordToPDF DocPath flag=flag+1 End If Next WScript.Echo "Totally " & FileNumber & " files in the folder and convert " & flag & " Word Documents to PDF fles." Else If GetWordFile(DocPaths) Then 'if the object is a file,then check if the file is a Word document.if that, convert it Dim DocPath DocPath = DocPaths ConvertWordToPDF DocPath Else WScript.Echo "Please drag a word document or a folder with word documents." End If End If Case Else WScript.Echo "Please drag a word document or a folder with word documents." End Select End Sub Function ConvertWordToPDF(DocPath) 'This function is to convert a word document to pdf file Dim objshell,ParentFolder,BaseName,wordapp,doc,PDFPath Set objshell= CreateObject("scripting.filesystemobject") ParentFolder = objshell.GetParentFolderName(DocPath) 'Get the current folder path BaseName = objshell.GetBaseName(DocPath) 'Get the document name PDFPath = parentFolder & "\" & BaseName & ".pdf" Set wordapp = CreateObject("Word.application") Set doc = wordapp.documents.open(DocPath) doc.saveas PDFPath,17 doc.close wordapp.quit Set objshell = Nothing End Function Function GetWordFile(DocPath) 'This function is to check if the file is a Word document Dim objshell Set objshell= CreateObject("scripting.filesystemobject") Dim Arrs ,Arr Arrs = Array("doc","docx") Dim blnIsDocFile,FileExtension blnIsDocFile= False FileExtension = objshell.GetExtensionName(DocPath) 'Get the file extension For Each Arr In Arrs If InStr(UCase(FileExtension),UCase(Arr)) <> 0 Then blnIsDocFile= True Exit For End If Next GetWordFile = blnIsDocFile Set objshell = Nothing End Function Function StopWordApp 'This function is to stop the Word application Dim strComputer,objWMIService,colProcessList,objProcess strComputer = "." Set objWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 'Get the WinWord.exe Set colProcessList = objWMIService.ExecQuery _ ("SELECT * FROM Win32_Process WHERE Name = 'Winword.exe'") For Each objProcess in colProcessList 'Stop it objProcess.Terminate() Next End Function Call main

Answer1:

This will convert all Excel files into PDF files.

Sub Convert_Excel_To_PDF() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String, Fnum As Long Dim mybook As Workbook Dim CalcMode As Long Dim sh As Worksheet Dim ErrorYes As Boolean Dim LPosition As Integer 'Fill in the path\folder where the Excel files are MyPath = "c:\Documents and Settings\shuerya\Desktop\ExcelFiles\" FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If Fnum = 0 Do While FilesInPath <> "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With If Fnum > 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then LPosition = InStr(1, mybook.Name, ".") - 1 mybookname = Left(mybook.Name, LPosition) mybook.Activate 'All PDF Files get saved in the directory below: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Documents and Settings\shuerya\Desktop\PDFFiles\" & mybookname & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=False End If mybook.Close SaveChanges:=False Next Fnum End If If ErrorYes = True Then MsgBox "There are problems in one or more files, possible problem:" _ & vbNewLine & "protected workbook/sheet or a sheet/range that not exist" End If With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub

Can you work with that??

Recommend

  • Download PDF file from Web location and Prompt user SaveAs box on client in web-Application ASP C#
  • Displaying information on non-installed RPM package?
  • C#: Insert and indent bullet points at bookmark in word document using Office Interop libraries
  • Nested Bulleted lists in Novacode docx
  • how to translate xml using xslt with complex rules
  • You tube videos are not playing
  • Delphi: Where is the shortcut that started the application? [duplicate]
  • New Firebase failed: First argument must be a valid firebase URL and the path can't contain “.”
  • php script is parsing content from RTE (tt_news) but internal links are not appearing as speaking ur
  • Python delete lines of text line #1 till regex
  • msbuild create itemgroup from property group
  • How do I include a SWC in an AS2 Flash project?
  • Jquery popup on mouse over of calendar control
  • cygwin cannot exec 'git-add--interactive' permission denied
  • WPF Visiblity Binding to Boolean Expression with multiple Variables
  • how to upload multiple files in c# windows application
  • MS Access - How to change the linked table path by amend the table
  • JBoss External Properties Files in Classpath
  • Connect .sks to skscene.h
  • Why does access(2) check for real and not effective UID?
  • Checking free space on FTP server
  • How to avoid particles glitching together in an elastic particle collision simulator?
  • Change Inet root folder for iis 7
  • Paperclip, set path outside of rails root folder
  • Recording logins for password protected directories
  • Splitting given String into two variables - php
  • script to move all files from one location to another location
  • Check if a string to interpolate provides expected placeholders
  • ILMerge & Keep Assembly Name
  • Symfony2: How to get request parameter
  • Timeout for blocking function call, i.e., how to stop waiting for user input after X seconds?
  • AT Commands to Send SMS not working in Windows 8.1
  • Run Powershell script from inside other Powershell script with dynamic redirection to file
  • Proper folder structure for lots of source files
  • Rails 2: use form_for to build a form covering multiple objects of the same class
  • Load html files in TinyMce
  • How do I configure my settings file to work with unit tests?
  • Is it possible to post an object from jquery to bottle.py?
  • Append folder name and increment by 1 using batch script
  • Reading document lines to the user (python)