Powerpoint automation using vbscript - vbscript

I am getting error message with the following code:
Dim objPPT As PowerPoint.Application
Dim objPres As PowerPoint.Presentation
'Opening blank presentation
Set objPPT = WScript.CreateObject("PowerPoint.Application")
objPPT.visible = 1
Set objPres = objPPT.presentations.Add
objPres.Slides.Add (1, PowerPoint.PpSlideLayout.ppLayoutBlank)
This Script stops execution prompting error message as Line 1 Char 12 Expected End of statement
I am new to vbscript, Please help if I am making some mistake.

To use vbscript, you must know syntax of vbscript. Below is example code to Add a Slide to PPT (PPT Template used here)
' Add a Slide to a Microsoft PowerPoint Presentation
Const ppLayoutText = 2
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set objPresentation = objPPT.Presentations.Add
objPresentation.ApplyTemplate _
("C:\Program Files\Microsoft Office\Templates\1033\ProjectStatusReport.potx")
Set objSlide = objPresentation.Slides.Add _
(1, ppLayoutText)

Related

VBScript Add Validation Object runtime error [duplicate]

This question already has answers here:
Getting an error `xlValues` is not defined when Cells format to the others
(3 answers)
Closed 2 years ago.
I have the following VBScript code.
Dim xlapp ' as excel object
Dim WSx, WSy ' as excel worksheet
Dim x, y ' as workbook
Dim fso
Dim list1
Set xlapp = CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fullpath
fullpath = fso.GetParentFolderName(WScript.ScriptFullName)
Set x = xlapp.Workbooks.Open(fullPath & "\File1.xlsx")
Set y = xlapp.Workbooks.Open(fullPath & "\File2.xlsm")
Set WSx = x.Worksheets("Sheet1")
Set WSy = y.Worksheets("Sheet1")
WSy.Cells.Clear
WSx.UsedRange.Copy WSy.Range("A1")
Set WSx = nothing
x.Close
WSy.Range("F1").Value="Yes/No"
With WSy.Range("F2").Validation
.Add xlValidateList, xlValidAlertStop, , "Option1,Option2"
.ErrorTitle = "Not a Valid Selection"
.ErrorMessage = "Please make sure you spelled the item correctly or select the item from the dropdowm menu."
.IgnoreBlank = True
.InCellDropdown = True
End With
Set WSy = nothing
y.Save
y.close
xlapp.quit
When executing this code, I get the following error on this line:
.Add xlValidateList, xlValidAlertStop, , "Option1,Option2"
microsoft vbscript runtime error unknown runtime error
Any suggestions on how to resolve this?
You are supplying Excel built-in constants xlValidateList and xlValidAlertStop but you are not in an Excel macro.
VBScript does not support them, you have to use their actual value. Instead of xlValidateList use 3 (see here). It is common to declare them in your script as contants.
Option Explicit
Const xlValidateList = 3
'Const xlValidAlertStop = "didn't look this one up"

Error on merging ppt files using visual basic scripting

I am a newbie to visual basic scripting..
I was trying to combine multiple ppt files into a single ppt using the following .vbs code.
it was supposed to create a new ppt called merged.ppt from all the ppts stored in a subfolder called PPTmerge.
But on executing I get error on line:
Set out = Application.Presentations.Open(f)
Can someone help me please...!
Const PPTMERGE_FILE = "Merged.ppt"
Const PPTMERGE_FOLDER = ".\PPTmerge"
Dim Application
Set Application=CreateObject("PowerPoint.Application")
Application.Visible = True 'must do this for merge to work
Dim first 'to open power point only once
first = True
Dim fs
Set fs=CreateObject("Scripting.FileSystemObject")
Dim folder
Set folder = fs.GetFolder(PPTMERGE_FOLDER)
Dim out
Dim f
Dim ff
For Each ff in folder.Files
f = PPTMERGE_FOLDER + "\" + ff.Name
If first Then
Dim p
Set out = Application.Presentations.Open(f)
out.SaveAs PPTMERGE_FOLDER + "\..\" + PPTMERGE_FILE
first = False
Else
out.Slides.InsertFromFile f, out.Slides.Count
End If
Next
If Not first Then
out.Save
out.SlideShowSettings.Run
'out.Close
End If
Set folder = Nothing
Set out = Nothing
Set folder = Nothing
'Application.Quit
Set Application = Nothing
You haven't specified the full path name.
Try const pptmerge_folder = "full path name here"
The code on line 2.

vb script not working on windows 8

I have a script that I'm using to add watermarks to pdf and worked fine with windows vista and xp
With windows script I'm getting this error :
80070005
This is the script I'm using :
Option Explicit
Const Watermark = "watermark.pdf"
Const Watermark2 = "AAAWatermark.pdf"
Dim objArgs, fname, tfname, fso, pdf
Set objArgs = WScript.Arguments
fname = objArgs(0)
Set fso = CreateObject("Scripting.FileSystemObject")
tfname = fso.GetTempName
Set pdf = WScript.CreateObject("pdfforge.pdf.pdf")
pdf.StampPDFFileWithPDFFile fname, tfname, Watermark, 1, 9999, false, 1, 10
If fso.FileExists(tfname) Then
fso.DeleteFile(fname)
fso.MoveFile tfname, fname
Else
MsgBox "There was an error adding the Watermark!", vbCritical, AppTitle
End If
Set pdf = Nothing
Set fso = Nothing
Set objArgs = Nothing
Any ideal please?
Thank you
Although I'm a little rough with my Francais, it would appear that you do not have rights to save temporary files in that directory mentioned in the error box or the directory does not exist? You could right click the folder and go to le security tab and add the everyone object and assign write access (or something more secure if you have some other group, etc)
(Edit: The original post had a screenshot in French for added context here)

Error when creating MS Excel docs with VB 2010

I'm having some trouble with looping and creating MS Excel docs, code snippet below
Private Sub selectedRowsButton_Click( _
ByVal sender As Object, ByVal e As System.EventArgs) _
Handles selectedRowsButton.Click
Dim selectedRowCount As Integer = _
DataGridView1.Rows.GetRowCount(DataGridViewElementStates.Selected)
If selectedRowCount > 0 Then
Dim sb As New System.Text.StringBuilder()
Dim objexcel As New Excel.Application
Dim i As Integer
Dim FACode As Integer
Dim Sitename As Integer
Dim Sitecode As Integer
Dim Address As Integer
Dim City As Integer
Dim State As Integer
Dim ZIP As Integer
FACode = 1
Sitename = 5
Sitecode = 2
Address = 6
City = 7
State = 9
ZIP = 10
Dim xlWorkbook As Excel.Workbook
xlWorkbook = objexcel.Workbooks.Open("template path")
For i = 0 To selectedRowCount - 1
objexcel.Visible = True
objexcel.Range("B2").Value = DataGridView1.SelectedCells(Sitename).Value.ToString()
objexcel.Range("B3").Value = DataGridView1.SelectedCells(Sitecode).Value.ToString()
objexcel.Range("B5").Value = DataGridView1.SelectedCells(FACode).Value.ToString()
Dim thisfile As Object
thisfile = objexcel.Range("B5").Value & "." & _
objexcel.Range("B3").Value & "." & "otherstring" & "." & "otherstring2" & "." & ".xls"
With objexcel
xlWorkbook.SaveAs(Filename:="c:\test\" & thisfile)
'~~> Close the Excel file without saving
xlWorkbook.Close(False)
End With
Next i
End If
I'm getting the error Exception from HRESULT: 0x800A03EC for the statement
objexcel.Range("B2").Value = DataGridView1.SelectedCells(Sitename).Value.ToString()
IF I select only one row of my DataGrid before creating the program works fine, it is when I select multiple rows that this error occurs. Since I'm creating the program specifically for multiple row selections I'm stumped as to where I've gone wrong. Any help or pointers appreciated, Thanks!
Two things
You have declared objexcel As Excel.Application so you shouldn't use objexcel.Range("B2").Value. Use xlWorkbook.Range("B2").Value. Change it everywhere in your code.
You cannot use SaveAs like that. See the snapshot below. If you want to save as xls file then you have to use FileFormat:=56
See this code example
'~~> Save As file
xlWorkbook.SaveAs(Filename:="c:\test\" & thisfile, FileFormat:=56)
If you do not specify the file format then you will get an error message when you open the file after opening.
You might want to look at this link on how to automate Excel from VB.Net
Topic: VB.NET and Excel
Link: http://www.siddharthrout.com/vb-dot-net-and-excel/
I am not too sure what you exactly are trying to do with the DGV. Like Sean mentioned you are not incrementing the values. If you can post a snapshot of how your DGV looks and how your Excel file should look after the export then we can help you in a much better way :)

VBS Runtime error code 800A01B6

I am a newbie to VBS scripting. I am getting above error on line 54, character 5 in script below. This error says "Object doesn't support this property or method: 'MimeMapArray'".
And line it is referring to is:
MimeMapArray(i) = CreateObject("MimeMap")
Can u tell me what I am doing wrong? Here is the script in its entirety. Note, I am trying to run this on an XP OS by double-clicking this VBS file.
' This script adds the necessary Windows Presentation Foundation MIME types
' to an IIS Server.
' To use this script, just double-click or execute it from a command line.
' Running this script multiple times results in multiple entries in the IIS MimeMap.
' Set the MIME types to be added
Dim MimeMapObj
Dim MimeMapArray
Dim WshShell
Dim oExec
Const ADS_PROPERTY_UPDATE = 2
Dim MimeTypesToAddArray
MimeTypesToAddArray = Array(".manifest", "application/manifest", ".xaml", _
"application/xaml+xml", ".application", "application/x-ms-application", _
".deploy", "application/octet-stream", ".xbap", "application/x-ms-xbap", _
".xps", "application/vnd.ms-xpsdocument")
' Get the mimemap object
Set MimeMapObj = GetObject("IIS://LocalHost/MimeMap")
' Call AddMimeType for every pair of extension/MIME type
For counter = 0 to UBound(MimeTypesToAddArray) Step 2
AddMimeType MimeTypesToAddArray(counter), MimeTypesToAddArray(counter+1)
Next
' Create a Shell object
Set WshShell = CreateObject("WScript.Shell")
' Stop and Start the IIS Service
Set oExec = WshShell.Exec("net stop w3svc")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
Set oExec = WshShell.Exec("net start w3svc")
Do While oExec.Status = 0
WScript.Sleep 100
Loop
Set oExec = Nothing
' Report status to user
WScript.Echo "Windows Presentation Foundation MIME types have been registered."
' AddMimeType Sub
Sub AddMimeType(ByVal Ext, ByVal MType)
' Get the mappings from the MimeMap property.
MimeMapArray = MimeMapObj.GetEx("MimeMap")
' Add a new mapping.
i = UBound(MimeMapArray) + 1
ReDim Preserve MimeMapArray(i)
MimeMapArray(i) = CreateObject("MimeMap")
MimeMapArray(i).Extension = Ext
MimeMapArray(i).MimeType = MType
MimeMapObj.PutEx ADS_PROPERTY_UPDATE, "MimeMap", MimeMapArray
MimeMapObj.SetInfo()
End Sub
The first thing I can suggest is use cscript to execute. You can get more information that won't go away like with a message box.
Open a command prompt (go to start,
run, type CMD).
Go to the location where your script
is and type the following:
cscript scriptname.vbs
...where scriptname.vbs is the name of your script.
Second, you appear to be missing the "set" in front of your createobject line. Have a look here for reference.
That line should look like:
set MimeMapArray(i) = CreateObject("MimeMap")

Resources