save pptx as pdf through excel - vba

I am trying to convert all pptx files in a give path to pdf files.
my code:
Sub pptxtopdf()
Dim ppt As Object
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
On Error Resume Next
Set ppt = GetObject(, "PowerPoint.Application")
If ppt Is Nothing Then
Set ppt = CreateObject("PowerPoint.Application")
End If
On Error GoTo 0
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("P:\Operations\Data & Deliverables\Projects\Amica\presentation_workspace\1_ spring 2015\Presentations\Volvo")
i = 1
'loops through each file in the directory
For Each objFile In objFolder.Files
Set WDReport = ppt.Presentations.Open(objFile.Path)
Dim FileName2 As String
FileName2 = Replace(objFile.Path, "pptx", "pdf")
'WDReport.ExportAsFixedFormat FileName2, ppFixedFormatTypePDF
WDReport.SaveAs FileName2, ppSaveAsPDF
WDReport.Close
ppt.Quit
Set ppt = Nothing
Set WDReport = Nothing
i = i + 1
Next objFile
End Sub
error msg
Presentation.SaveAs : Invalid enumeration value.
Cannot see what I'm doing wrong?
same problem as here but the solution didnt work for me - Excel macro to save pptx as pdf; error with code

You are late binding PowerPoint.Application so its enumeration values are not exposed or available in the global VBA namespace.
As you have not added option explicit to warn you of undeclared variables your use of the undeclared ppSaveAsPDF causes no error but has no value.
Add:
const ppSaveAsPDF as long = 32
To the top of the module to provide the expected value to SaveAs.

Related

Object Required Error - Populate PPT from Word using VBA

Sub SendToPPT()
Dim ppt As Object
Set ppt = CreateObject("Powerpoint.Application")
ppt.Presentations.Open ActivePresentation.Path & "\" & "Allegation.pptx"
For i = 6 To 24
ppt.Slides(i).Shapes(1).TextFrame.TextRange = ActiveDocument.Paragraphs(i).Range.Text
Next i
ppt.Save
ppt.Close
Set ppt = Nothing
End Sub
I'm receiving a
Run time Error 424: Object Required.
I'm unable to figure out where I'm going wrong. The file path is correct, I've cross-checked it.
ppt is the "Powerpoint.Application" but ppt.Slides(i) expects a presentation not the powerpoint application.
Dim Pres As Object
Set Pres = ppt.Presentations.Open(ActivePresentation.Path & "\" & "Allegation.pptx")
Dim i As Long
For i = 6 To 24
Pres.Slides(i).Shapes(1).TextFrame.TextRange = ActiveDocument.Paragraphs(i).Range.Text
Next i
Pres.Save
Pres.Close
Set Pres = Nothing
Set ppt = Nothing

Open other application from vba

I am working on a macro to open a file(might already be open) and save with new name and then open the new file from vba in excel.
This file can Powerpoint,mathcad,visio, word etc..(can also be template files such as dotx etc..)
So my idea is that:
I first need to figure out if the application is open or not,
then I somehow need to figure if the file is open or not,
then save it with the new filename.
Open the new document
Go through the document and dumps custom variables into the database, populate custom variables from database(Not shown in code below, seperate module)
Activate the new document so that the user can edit it.
Public Sub saveAsVBADocument(filenameNew As String, fileNameOld As String, applicationType As String)
Dim objectApplication As Object
Dim documentApplication As Object
On Error Resume Next
Set objectApplication = GetObject(, applicationType)
On Error GoTo 0
If objectApplication Is Nothing Then
Set objectApplication = CreateObject(applicationType)
End If
objectApplication.Visible = True
On Error Resume Next
Set documentApplication = objectApplication.Workbooks(FileHandling.GetFilenameFromPath(fileNameOld)) 'Excel
Set documentApplication = objectApplication.Documents(FileHandling.GetFilenameFromPath(fileNameOld)) 'Word
Set documentApplication = objectApplication.WorkSheets(FileHandling.GetFilenameFromPath(fileNameOld)) 'Mathcad
Set documentApplication = objectApplication.Presentations(FileHandling.GetFilenameFromPath(fileNameOld)) 'PowerPoint
Set documentApplication = objectApplication.Projects(FileHandling.GetFilenameFromPath(fileNameOld)) 'MS Project "Msproject.Application"
Set documentApplication = objectApplication.Documents(FileHandling.GetFilenameFromPath(fileNameOld)) 'MS Visio "Visio.Application"
If documentApplication Is Nothing Then
Set documentApplication = objectApplication.FileOpen(fileNameOld) ' add read only
End If
documentApplication.SaveAs filename:=filenameNew
Set objectApplication = Nothing
Set documentApplication = Nothing
End Sub
What is a possible solution to handle all vba acceptable document types?
You can use GetObject("Filename") to open a file directly in its application. So something like this can open any file that has its extension in the Windows Registry. That will be most file types; certainly the Office applications. Whether you'll be able to use SaveAs will depend on whether those applications support OLE Server (meaning they have a coding interface exposed). Again, all the Office applications do support this.
You'll probably want to put in some error-handling for the case the application for the file extension can't be found in the Registry. And of course in case the file name doesn't exist.
My example is for Excel and Word, only - you should be able to fill in others. My code makes sure the file is visible and available to the user as that makes it easier to trouble-shoot. You can, of course, change that once you have everything working satisfactorily.
Sub OpenFileInUnknownApp()
Dim objFile As Object
Dim objApp As Object
Dim sPath As String, sExt As String
Dim sFileName As String
Dim sAppName As String
Dim snewfilename As String
sPath = "C:\Test\"
sFileName = sPath & "Quote.docx" 'RngNames.xlsx"
snewfilename = sPath & "NewName"
'''Open the file in its application
Set objFile = GetObject(sFileName)
Set objApp = objFile.Application
sAppName = objApp.Name
Select Case sAppName
Case Is = "Microsoft Excel"
Dim wb As Excel.Workbook
sExt = "xlsx"
objApp.Visible = True
Set wb = objFile
wb.Activate
wb.Windows(1).Visible = True
objApp.UserControl = True 'so that it "lives" after the code ends
objApp.Activate
wb.SaveAs "sNewFileName" & sExt
Case Is = "Microsoft Word"
Dim doc As word.Document
sExt = "docx"
objApp.Visible = True
Set doc = objFile
objApp.Activate
doc.SaveAs2 "sNewFileName" & sExt
Case Else
End Select
Set objFile = Nothing
Set objApp = Nothing
End Sub

How do I obtain the path towards the macro using the macro (vba code) itself?

Note: I am not interested in finding the path towards the worksheet, I intend to write the path to the worksheet in a text file that is located in the same folder as the .OTM file.
I need to transform this code from hardcoded path to a path read from a text file located in the same folder as the macro.
How do I obtain the path towards the macro using the macro (vba code) itself?
Public xlApp As Object
Public xlWB As Object
Public xlSheet As Object
Sub OpenXl()
Dim enviro As String
Dim strPath As String
enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
strPath = enviro & "\Documents\test2.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")
' Process the message record
On Error Resume Next
End Sub
The OTM file is stored here on my PC (Windows 7/Outlook 2010):
strPath = Environ("userprofile") & "\AppData\Roaming\Microsoft\Outlook\"
Simply use:
ThisWorkbook.Path
This returns the path of the workbook containing the code.

Read Data From excel with vb.net

I have a vb.net console application and i am trying to read data from all excel files in a folder. In the second loop i get these error.
An unhandled exception of type 'System.ArgumentException' occurred in Microsoft.VisualBasic.dll
Additional information: Argument 'Prompt' cannot be converted to type 'String'.
Thanks for help.
Here is my code...
Sub Main()
Dim objFSO, objStartFolder, objFolder, colFiles, Path, a
objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "C:\Users\Administrator\Desktop\Excel Files"
objFolder = objFSO.GetFolder(objStartFolder)
colFiles = objFolder.Files
For Each objFile In colFiles
Path = objStartFolder + "\" + objFile.Name
Dim objexcel, objWorkbook, ex
objexcel = CreateObject("Excel.Application")
objexcel.Application.Visible = True
objWorkbook = objexcel.Workbooks.Open(Path)
ex = objWorkbook.Worksheets(1)
For i As Integer = 1 To 50
a = ex.Cells(i, 5)
MsgBox(a)
Next
objexcel.Quit()
Next
End Sub
ex.Cells(i, 5) doesn't return a string, rather an object representing the Range you've specified. So to access the value you need to change the type
MessageBox.Show(CType(ex.Cells(i, 5), Microsoft.Office.Interop.Excel.Range).Value.ToString())
You will need to add a reference to Microsoft.Office.Interop.Excel in your project. You will then also be able to strongly type your Excel objects if you want, ie:
Dim objExcel As New Microsoft.Office.Interop.Excel.Application()
Also on a side note you should probably stop using COM objects (Scripting.FileSystemObject) and use native managed .Net code instead. You can get the same functionality as above by just using the following code
'Get me all filenames with file extension .xlsx
Dim fileNames() As String = System.IO.Directory.GetFiles("C:\Users\Administrator\Desktop\Excel Files\")
'Loop through array of filenames
For Each fileName As String In fileNames
'Other excel code here
objExcel.Workbooks.Open(fileName)
Next

Copy Worksheet Object Defined Error in Excel

I see this issue has come up a handful of times on this forum however none of the solutions have helped me. The code below actually did work, but then it started throwing an application-defined or objected defined error and now will not work. The code runs from within an Excel template, opens up each Excel report in the directory, then pastes 2 worksheets into the document.
Sub updateED()
Dim pathout, pathin As String
Dim WbOutput As Workbook
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(filepath)
'step through each xls file
For Each objFile In objFolder.Files
If InStr(objFile, ".xls") Then
Set WbOutput = Workbooks.Open(objFile)
Application.DisplayAlerts = False
'drop in additional templates
ThisWorkbook.Sheets(Array("Business Entity", "Facility")).Copy before:=WbOutput.Sheets("Mbr_Detail_ED")
End If
Next
End Sub
See if this helps
Option Explicit
Sub updateED()
Dim Pathout As String
Dim Pathin As String
Dim WbOutput As Workbook
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Temp\")
'step through each xls file
For Each objFile In objFolder.Files
If InStr(objFile, ".xls") Then
Set WbOutput = Workbooks.Open(objFile)
Application.DisplayAlerts = False
'drop in additional templates
ThisWorkbook.Sheets(Array("Business Entity", "Facility")).Copy before:=WbOutput.Sheets("Mbr_Detail_ED")
End If
Next
End Sub