<?xml version='1.0' encoding='UTF-8'?><?xml-stylesheet href="http://www.blogger.com/styles/atom.css" type="text/css"?><feed xmlns='http://www.w3.org/2005/Atom' xmlns:openSearch='http://a9.com/-/spec/opensearchrss/1.0/' xmlns:georss='http://www.georss.org/georss' xmlns:gd='http://schemas.google.com/g/2005' xmlns:thr='http://purl.org/syndication/thread/1.0'><id>tag:blogger.com,1999:blog-4782001763166047799</id><updated>2011-07-30T21:09:01.113-07:00</updated><category term='powerpoint'/><category term='vba'/><category term='design'/><category term='templates'/><category term='sqlplus oracle linux prompt history bash backspace erase stty'/><category term='slides'/><category term='visual basic'/><category term='master'/><title type='text'>Snippets and Snails</title><subtitle type='html'></subtitle><link rel='http://schemas.google.com/g/2005#feed' type='application/atom+xml' href='http://snippetsandsnails.blogspot.com/feeds/posts/default'/><link rel='self' type='application/atom+xml' href='http://www.blogger.com/feeds/4782001763166047799/posts/default?max-results=100'/><link rel='alternate' type='text/html' href='http://snippetsandsnails.blogspot.com/'/><link rel='hub' href='http://pubsubhubbub.appspot.com/'/><author><name>Dave</name><uri>http://www.blogger.com/profile/04629446239047577482</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='16' height='16' src='http://img2.blogblog.com/img/b16-rounded.gif'/></author><generator version='7.00' uri='http://www.blogger.com'>Blogger</generator><openSearch:totalResults>4</openSearch:totalResults><openSearch:startIndex>1</openSearch:startIndex><openSearch:itemsPerPage>100</openSearch:itemsPerPage><entry><id>tag:blogger.com,1999:blog-4782001763166047799.post-7133817379782625324</id><published>2010-02-12T16:19:00.000-08:00</published><updated>2010-02-12T16:31:40.857-08:00</updated><category scheme='http://www.blogger.com/atom/ns#' term='sqlplus oracle linux prompt history bash backspace erase stty'/><title type='text'>sqlplus Wrapper Script For Linux</title><content type='html'>Installed Oracle 10g on RHEL5 x86_64 today and the sqlplus command prompt was driving me bats.  &lt;a href"http://beyondoracle.wordpress.com/2008/10/22/improve-sqlplus-before-you-get-crazy/"&gt;This post&lt;/a&gt; gave some great tips on fixing sqlplus behavior.  I combined them in one shell script to fix the backspace issue and the lack of history.&lt;br /&gt;&lt;br /&gt;&lt;br /&gt;First, as the root user, install &lt;a href="http://utopia.knoware.nl/~hlub/rlwrap/"&gt;rlwrap&lt;/a&gt;.  It should be a simple download, untar, then &lt;code&gt;configure; make install;&lt;/code&gt; as root.&lt;br /&gt;&lt;br /&gt;Once rlwrap is installed and working, create &lt;code&gt;sqlplus.sh&lt;/code&gt; as the user who is going to be running sqlplus (change ~/ to whatever path you deem appropriate for the script):&lt;br /&gt;&lt;br /&gt;&lt;code&gt;&lt;br /&gt;#!/bin/bash&lt;br /&gt;stty erase ^H&lt;br /&gt;rlwrap sqlplus $@&lt;br /&gt;stty erase ^?&lt;br /&gt;&lt;/code&gt;&lt;br /&gt;&lt;br /&gt;Make the script executable:&lt;br /&gt;&lt;code&gt;chmod 0755 ~/sqlplus.sh&lt;/code&gt;&lt;br /&gt;&lt;br /&gt;And in ~/.bashrc, add&lt;br /&gt;&lt;code&gt;&lt;br /&gt;alias sqlplus=’~/sqlplus.sh’&lt;br /&gt;&lt;/code&gt;&lt;br /&gt;&lt;br /&gt;Voilà!  Your Linux sqlplus prompt should now be a bit more friendly.&lt;div class="blogger-post-footer"&gt;&lt;img width='1' height='1' src='https://blogger.googleusercontent.com/tracker/4782001763166047799-7133817379782625324?l=snippetsandsnails.blogspot.com' alt='' /&gt;&lt;/div&gt;</content><link rel='replies' type='application/atom+xml' href='http://snippetsandsnails.blogspot.com/feeds/7133817379782625324/comments/default' title='Post Comments'/><link rel='replies' type='text/html' href='http://www.blogger.com/comment.g?blogID=4782001763166047799&amp;postID=7133817379782625324' title='0 Comments'/><link rel='edit' type='application/atom+xml' href='http://www.blogger.com/feeds/4782001763166047799/posts/default/7133817379782625324'/><link rel='self' type='application/atom+xml' href='http://www.blogger.com/feeds/4782001763166047799/posts/default/7133817379782625324'/><link rel='alternate' type='text/html' href='http://snippetsandsnails.blogspot.com/2010/02/sqlplus-wrapper-script-for-linux.html' title='sqlplus Wrapper Script For Linux'/><author><name>Dave</name><uri>http://www.blogger.com/profile/04629446239047577482</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='16' height='16' src='http://img2.blogblog.com/img/b16-rounded.gif'/></author><thr:total>0</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4782001763166047799.post-533070579127063590</id><published>2010-02-09T13:54:00.000-08:00</published><updated>2010-02-09T16:19:36.308-08:00</updated><title type='text'>How to Delete Embedded Excel Objects in VBA</title><content type='html'>I wanted to do a bulk delete of embedded chemical structures in a series of Excel workbooks, without touching embedded graphs and data tables.  Here's the resulting VBA code.  You should be able to easily modify this to delete any custom object types in an Excel workbook.&lt;br /&gt;&lt;br /&gt;&lt;small&gt;&lt;pre&gt;&lt;br /&gt;&lt;br /&gt;Sub WipeObjects&lt;br /&gt;' Delete all current embedded chemical structures from currently open Excel workbook&lt;br /&gt;' Example sub to call ChemObjectWipe function&lt;br /&gt;    MsgBox ChemObjectWipe()&lt;br /&gt;End Sub&lt;br /&gt;&lt;br /&gt;Function ChemObjectWipe() As String&lt;br /&gt;    Dim currSheet As Worksheet&lt;br /&gt;    Dim itemnum As Long&lt;br /&gt;    For Each currSheet In ActiveWorkbook.Sheets&lt;br /&gt;        Dim structures As New Collection&lt;br /&gt;        Dim embeddedItems As OLEObjects&lt;br /&gt;        Dim shp As OLEObject&lt;br /&gt;        Dim deleteStatus As String&lt;br /&gt;        Dim creator, currName As String&lt;br /&gt;        Set embeddedItems = currSheet.OLEObjects&lt;br /&gt;        If (embeddedItems.Count &gt; 0) Then&lt;br /&gt;        For Each shp In embeddedItems&lt;br /&gt;            currName = ""&lt;br /&gt;            creator = ""&lt;br /&gt;            currName = shp.Name&lt;br /&gt;            creator = UCase(shp.progID)&lt;br /&gt;'            MsgBox currName &amp; creator &amp; " item number "&lt;br /&gt;            deleteStatus = ""&lt;br /&gt;' Return value&lt;br /&gt;            ChemObjectWipe = ChemObjectWipe &amp; currName &amp; "::" &amp; creator&lt;br /&gt;' Change substrings here to match different object creators&lt;br /&gt;            If ((InStr(creator, "ISIS") &lt;&gt; 0) Or (InStr(creator, "CHEM") &lt;&gt; 0) Or (InStr(creator, "MDL") &lt;&gt; 0)) Then&lt;br /&gt;'                MsgBox "Adding to delete queue " &amp; creator &amp; "::" &amp; currName&lt;br /&gt;                ChemObjectWipe = ChemObjectWipe &amp; "(ERASED)"&lt;br /&gt;                structures.Add (currName)&lt;br /&gt;            End If&lt;br /&gt;            ChemObjectWipe = ChemObjectWipe &amp; ";"&lt;br /&gt;        Next shp&lt;br /&gt;'        MsgBox "Count = " &amp; Str(structures.Count)&lt;br /&gt;        For itemnum = 1 To structures.Count&lt;br /&gt;            embeddedItems(structures.Item(itemnum)).Delete&lt;br /&gt;        Next itemnum&lt;br /&gt;        End If&lt;br /&gt;    Next currSheet&lt;br /&gt;End Function&lt;br /&gt;&lt;/pre&gt;&lt;/small&gt;&lt;div class="blogger-post-footer"&gt;&lt;img width='1' height='1' src='https://blogger.googleusercontent.com/tracker/4782001763166047799-533070579127063590?l=snippetsandsnails.blogspot.com' alt='' /&gt;&lt;/div&gt;</content><link rel='replies' type='application/atom+xml' href='http://snippetsandsnails.blogspot.com/feeds/533070579127063590/comments/default' title='Post Comments'/><link rel='replies' type='text/html' href='http://www.blogger.com/comment.g?blogID=4782001763166047799&amp;postID=533070579127063590' title='1 Comments'/><link rel='edit' type='application/atom+xml' href='http://www.blogger.com/feeds/4782001763166047799/posts/default/533070579127063590'/><link rel='self' type='application/atom+xml' href='http://www.blogger.com/feeds/4782001763166047799/posts/default/533070579127063590'/><link rel='alternate' type='text/html' href='http://snippetsandsnails.blogspot.com/2010/02/how-to-delete-embedded-excel-objects-in.html' title='How to Delete Embedded Excel Objects in VBA'/><author><name>Dave</name><uri>http://www.blogger.com/profile/04629446239047577482</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='16' height='16' src='http://img2.blogblog.com/img/b16-rounded.gif'/></author><thr:total>1</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4782001763166047799.post-640098510586602575</id><published>2008-11-20T17:54:00.001-08:00</published><updated>2008-11-21T13:03:51.139-08:00</updated><title type='text'>OLK Outlook Temp Folder</title><content type='html'>The Outlook 2003 design team came up with some strange ideas of how to cache attachments.  From &lt;a href="http://support.microsoft.com/kb/817878"&gt;Microsoft&lt;/a&gt; :&lt;br /&gt;&lt;blockquote&gt;&lt;small&gt;&lt;br /&gt;When you open file attachments that are considered safe, Outlook 2003 or Outlook 2007 puts these attachments in a subdirectory under the Temporary Internet Files directory as an additional precaution. When Outlook 2003 or Outlook 2007 first tries to use a temporary file, it examines the registry to determine whether the following value exists, depending on your version of Outlook.&lt;br /&gt;&lt;br /&gt;Outlook 2003&lt;br /&gt;HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Security&lt;br /&gt;&lt;br /&gt;Value Name: OutlookSecureTempFolder&lt;br /&gt;Data Type: REG_SZ&lt;br /&gt;Outlook 2007&lt;br /&gt;HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Security&lt;br /&gt;&lt;br /&gt;Value Name: OutlookSecureTempFolder&lt;br /&gt;Data Type: REG_SZ&lt;br /&gt;If the value exists, and if the value contains a valid path, Outlook 2003 or Outlook 2007 uses that location for its temporary files.&lt;br /&gt;&lt;br /&gt;If the registry value does not exist, or if it points to an invalid location, Outlook 2003 or Outlook 2007 creates a new subdirectory under the Temporary Internet Files directory and puts the temporary file in the new subdirectory. The name of the new subdirectory is unknown, is randomly generated, and takes on the following form, depending on your version of Outlook.&lt;br /&gt;&lt;br /&gt;Outlook 2003&lt;br /&gt;C:\Documents and Settings\username\Local Settings\Temporary Internet Files\OLKxxx&lt;br /&gt;In this example, username is the user name that is used by the person who is currently logged on to the computer, and xxx is a randomly generated sequence of letters and numbers.&lt;br /&gt;&lt;/small&gt;&lt;/blockquote&gt;&lt;br /&gt;&lt;br /&gt;If you open an attachment, change the file, and try to "Save As..." you will notice the default folder is this OLKxxx folder.  The OLK folder is hidden and you cannot use Explorer to browse to it without typing the address in the Path bar.&lt;br /&gt;&lt;br /&gt;There are several downsides to this approach.&lt;br /&gt;&lt;li&gt;Users can save important changes to a hidden folder, cannot find them via Explorer, then wail about disappearing files and version confusion.&lt;br /&gt;&lt;li&gt;Locked files won't be deleted by Outlook upon close and will accumulate in the OLK folder creating a treasure trove of semi-secret documents hidden on your local hard drive.&lt;br /&gt;&lt;li&gt;The foldername is semi-random, so it is difficult to script changes to the directory in a company.&lt;br /&gt;&lt;br /&gt;I wrote a vbs script to fix these problems that should be deployable as a logoff or logon script.  It does not require admin rights and should work with limited users in XP.  It does the following:&lt;br /&gt;&lt;br /&gt;&lt;li&gt;Find out what the current OLK directory is from the registry&lt;br /&gt;&lt;li&gt;Add Modify permissions to the directory via CACLS.exe, so accumulated attachments can be deleted &lt;br /&gt;&lt;li&gt;Reassign the OLK directory to a fixed path, create the new directory if it doesn't already exist&lt;br /&gt;&lt;li&gt;Remove Modify permissions from the new OutlookTempFolder directory.&lt;br /&gt;&lt;br /&gt;Users will now get a "Read Only" error when trying to save changes to the OutlookTempFolder.  The script leaves users with Read and Write privileges to allow Outlook to write the initial attachment to the directory.  Clicking "Save" on a modified document generates a "Read-Only File" warning in Outlook 2003.  If the user persists in trying to save to the directory, "Saving As..." results in a 0-byte file and error, since Outlook is creating the file, then Modifying it to add the data from the original file.  Either way it is more difficult to do the wrong thing, rather than change directory to a valid save location.&lt;br /&gt;&lt;br /&gt;Here is the script.  May it save many gnashed teeth.&lt;br /&gt;&lt;br /&gt;&lt;pre&gt;&lt;br /&gt;' Outlook 2003 Temp Folder Fix Script&lt;br /&gt;' (c) Dave S. Nov 2008&lt;br /&gt;' I assume no liability for use of this script.&lt;br /&gt;' http://snippetsandsnails.blogspot.com/&lt;br /&gt;' Please verify that it does what you want in a test environment first!&lt;br /&gt;' Freely redistributable with this attribution notice&lt;br /&gt;const HKEY_CURRENT_USER = &amp;H80000001&lt;br /&gt;const HKEY_LOCAL_MACHINE = &amp;H80000002&lt;br /&gt;strComputer = "."&lt;br /&gt;Set StdOut = WScript.StdOut&lt;br /&gt;myDomain = "WIDGETCO\"&lt;br /&gt;&lt;br /&gt;'' Get OLK directory from registry as user &lt;br /&gt;Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &amp;_ &lt;br /&gt;strComputer &amp; "\root\default:StdRegProv") &lt;br /&gt;strKeyPath = "SOFTWARE\Microsoft\Office\11.0\Outlook\Security"&lt;br /&gt;strValueName = "OutlookSecureTempFolder"&lt;br /&gt;oReg.GetStringValue HKEY_CURRENT_USER,strKeyPath,strValueName,strValue&lt;br /&gt;OLKdir = "nonexistentdirectory"&lt;br /&gt;OLKdir = strValue&lt;br /&gt;&lt;br /&gt;' Set up the new location for OLK to reside&lt;br /&gt;Set WshShell = CreateObject("WScript.Shell")&lt;br /&gt;newOLK = WshShell.ExpandEnvironmentStrings("%HOMEDRIVE%") &amp;  WshShell.ExpandEnvironmentStrings("%HOMEPATH%") &amp; "\" &amp; "OutlookTempFiles"&lt;br /&gt;' Get current username&lt;br /&gt;userName = myDomain &amp; WshShell.ExpandEnvironmentStrings("%USERNAME%")&lt;br /&gt;&lt;br /&gt;'' We have the OLK directory, now empty it &lt;br /&gt;&lt;br /&gt;Set objFSO = CreateObject("Scripting.FileSystemObject")&lt;br /&gt;Set objFolder = objFSO.GetFolder(OLKdir)&lt;br /&gt;' Set colSubfolders = objFolder.Subfolders&lt;br /&gt;&lt;br /&gt;If objFSO.FolderExists(OLKdir) Then&lt;br /&gt;'    Wscript.Echo "OLK Folder " &amp; OLKdir  &amp; " exists."&lt;br /&gt;    Set objShell = CreateObject("Wscript.Shell")&lt;br /&gt;' Grant change rights to allow deletion of files    &lt;br /&gt;    iRetVal = objShell.Run("%SystemRoot%\System32\Cacls.exe " &amp; Chr(34) &amp; newOLK &amp; _&lt;br /&gt;        Chr(34) &amp; " /E /T /G " &amp; userName &amp; ":C", 0, True) &lt;br /&gt;    Set objShell = Nothing    &lt;br /&gt;    Set files = objFolder.Files&lt;br /&gt;    On Error Resume Next&lt;br /&gt;    For each file In files&lt;br /&gt;        OLKFile = OLKdir &amp; "\" &amp; file.Name&lt;br /&gt;' Do not delete subdirs, only delete files that are not locked etc.&lt;br /&gt;        If objFSO.FileExists(OLKFile) Then&lt;br /&gt;            objFSO.DeleteFile OLKFile, True&lt;br /&gt;        End If&lt;br /&gt;        If Err.Number Then&lt;br /&gt;'            Wscript.Echo "Failed deletion:" &amp; OLKFile&lt;br /&gt;            Err.Clear&lt;br /&gt;        End If&lt;br /&gt;    Next&lt;br /&gt;Else&lt;br /&gt;    Wscript.Echo "OLK Folder " &amp; OLKdir &amp; " does not exist, registry is in error."&lt;br /&gt;End If&lt;br /&gt;&lt;br /&gt;' Set up new OLK location&lt;br /&gt;&lt;br /&gt;If objFSO.FolderExists(newOLK) Then&lt;br /&gt;' Reset permissions on already existing folder    &lt;br /&gt;    Set objShell = CreateObject("Wscript.Shell")&lt;br /&gt;' Note /P replaces the user perms, /G additively adds perms    &lt;br /&gt;   iRetVal = objShell.Run("%SystemRoot%\System32\Cacls.exe " &amp; Chr(34) &amp; newOLK &amp; _&lt;br /&gt;        Chr(34) &amp; " /E /T /P " &amp; userName &amp; ":W", 0, True)&lt;br /&gt;    iRetVal = objShell.Run("%SystemRoot%\System32\Cacls.exe " &amp; Chr(34) &amp; newOLK &amp; _&lt;br /&gt;        Chr(34) &amp; " /E /T /G " &amp; userName &amp; ":R", 0, True) &lt;br /&gt;    Set objShell = Nothing&lt;br /&gt;Else&lt;br /&gt;' Create the folder and reset the registry&lt;br /&gt;    WScript.Echo "Creating new Outlook Temp Directory: " &amp; newOLK&lt;br /&gt;    objFSO.CreateFolder(newOLK)&lt;br /&gt;    strValue = newOLK&lt;br /&gt;' Directory is created.  Now grant Read and Write but not Modify to prevent OLK saving&lt;br /&gt;    Set objShell = CreateObject("Wscript.Shell")&lt;br /&gt;    iRetVal = objShell.Run("%SystemRoot%\System32\Cacls.exe " &amp; Chr(34) &amp; newOLK &amp; _&lt;br /&gt;        Chr(34) &amp; " /E /T /P " &amp; userName &amp; ":W", 0, True)&lt;br /&gt;    iRetVal = objShell.Run("%SystemRoot%\System32\Cacls.exe " &amp; Chr(34) &amp; newOLK &amp; _&lt;br /&gt;        Chr(34) &amp; " /E /T /G " &amp; userName &amp; ":R", 0, True)  &lt;br /&gt;    Set objShell = Nothing        &lt;br /&gt;    oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,strValueName,newOLK&lt;br /&gt;    If Err = 0 Then&lt;br /&gt;        oReg.GetStringValue HKEY_CURRENT_USER,strKeyPath,strValueName,finalValue&lt;br /&gt; '       WScript.Echo _&lt;br /&gt; '      "Can't set new directory - outlook folder location value is: " &amp; finalValue&lt;br /&gt;    Else &lt;br /&gt; '       WScript.Echo "Error in creating key" &amp; _&lt;br /&gt; '      " and String value = " &amp; Err.Number&lt;br /&gt;    End If&lt;br /&gt;End If&lt;br /&gt;&lt;/pre&gt;&lt;div class="blogger-post-footer"&gt;&lt;img width='1' height='1' src='https://blogger.googleusercontent.com/tracker/4782001763166047799-640098510586602575?l=snippetsandsnails.blogspot.com' alt='' /&gt;&lt;/div&gt;</content><link rel='replies' type='application/atom+xml' href='http://snippetsandsnails.blogspot.com/feeds/640098510586602575/comments/default' title='Post Comments'/><link rel='replies' type='text/html' href='http://www.blogger.com/comment.g?blogID=4782001763166047799&amp;postID=640098510586602575' title='7 Comments'/><link rel='edit' type='application/atom+xml' href='http://www.blogger.com/feeds/4782001763166047799/posts/default/640098510586602575'/><link rel='self' type='application/atom+xml' href='http://www.blogger.com/feeds/4782001763166047799/posts/default/640098510586602575'/><link rel='alternate' type='text/html' href='http://snippetsandsnails.blogspot.com/2008/11/olk-outlook-temp-folder.html' title='OLK Outlook Temp Folder'/><author><name>Dave</name><uri>http://www.blogger.com/profile/04629446239047577482</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='16' height='16' src='http://img2.blogblog.com/img/b16-rounded.gif'/></author><thr:total>7</thr:total></entry><entry><id>tag:blogger.com,1999:blog-4782001763166047799.post-249403964740612232</id><published>2008-08-11T17:33:00.000-07:00</published><updated>2008-08-11T18:29:31.100-07:00</updated><category scheme='http://www.blogger.com/atom/ns#' term='master'/><category scheme='http://www.blogger.com/atom/ns#' term='powerpoint'/><category scheme='http://www.blogger.com/atom/ns#' term='slides'/><category scheme='http://www.blogger.com/atom/ns#' term='design'/><category scheme='http://www.blogger.com/atom/ns#' term='templates'/><category scheme='http://www.blogger.com/atom/ns#' term='vba'/><category scheme='http://www.blogger.com/atom/ns#' term='visual basic'/><title type='text'>Changing All Your Powerpoint Slides to a New Template</title><content type='html'>So someone has decided that your current Powerpoint template sucks and needs to be replaced with a shiny new template.  Next question is, how do you update the 500+ legacy powerpoint presentations to the new template with a minimal amount of pain?&lt;br /&gt;&lt;br /&gt;Not VB!  I should have bit the bullet and done this in C# but it evolved from a simple sub to a larger script.  In any case, it works well enough and gets most slides right.  The goal was to be able to tolerate slide decks with multiple masters and only replace the background on slides using the previous template.  It's very chatty so redirect the output to a log file for large runs.  Also, rename the new Design to something unique so you can tell the new slides from the old ones later in case you need to re-run the script.&lt;br /&gt;&lt;br /&gt;Save the following code to a .vbs file and modify the top variables to reflect your own environment.&lt;br /&gt;&lt;br /&gt;EnumDesigns is taken from &lt;a href="http://skp.mvps.org/designs.htm"&gt;http://skp.mvps.org/designs.htm&lt;/a&gt;&lt;br /&gt;CheckFolders is from &lt;a href="http://www.windowsdevcenter.com/examples/windows/vbscriptpr_code.html"&gt;http://www.windowsdevcenter.com/examples/windows/vbscriptpr_code.html&lt;/a&gt;&lt;br /&gt;&lt;br /&gt;&lt;pre&gt;&lt;br /&gt;' setNewMasterDesign.vbs&lt;br /&gt;' This script will find ppts under the current directory, and set the template and&lt;br /&gt;' design to the current corporate template.&lt;br /&gt;' Makes duplicates of all slides found.&lt;br /&gt;' Works with PPT 2003 on WinXP&lt;br /&gt;' (c) Dave S. Aug 11 2008&lt;br /&gt;&lt;br /&gt;Dim currDir, templateFile, suffix, masterReplaceString, newDesign&lt;br /&gt;suffix=".ppt"&lt;br /&gt;''''''''&lt;br /&gt;' User defined variables&lt;br /&gt;currDir = "."&lt;br /&gt;' Where is the source template for the new master?&lt;br /&gt;templateFile = "C:\mytemplates\Default.pot"&lt;br /&gt;' Change this to whatever substring matches your old master slide design(s)&lt;br /&gt;masterReplaceString = "Default"&lt;br /&gt;' This is the name of the new Design to be applied to slides whose Design name matches masterReplaceString&lt;br /&gt;newDesign = "FreshAndClean"&lt;br /&gt;&lt;br /&gt;&lt;br /&gt;'''''''''''''&lt;br /&gt;WScript.Echo "Start Time:" &amp; Now&lt;br /&gt;&lt;br /&gt;Set FSO = CreateObject("Scripting.FileSystemObject")&lt;br /&gt;Set folder = FSO.GetFolder(currDir)&lt;br /&gt;Set files = folder.Files&lt;br /&gt;&lt;br /&gt;Set objPPT = CreateObject("PowerPoint.Application")&lt;br /&gt;objPPT.Visible = true&lt;br /&gt;&lt;br /&gt;WScript.Echo templateFile &amp; " is being opened...."&lt;br /&gt;Set masterPPT = objPPT.Presentations.Open(templateFile)&lt;br /&gt;EnumDesigns(masterPPT)&lt;br /&gt;&lt;br /&gt;' Search recursively for powerpoint files in the current directory&lt;br /&gt;CheckFolder folder, suffix, masterReplaceString&lt;br /&gt;objPPT.Quit&lt;br /&gt;&lt;br /&gt;''''''''''''''''''''''''''''''''''''''&lt;br /&gt;' Subs Begin&lt;br /&gt;''''''''''''''''''''''''''''''''''''''&lt;br /&gt;&lt;br /&gt;Sub CheckFolder(objCurrentFolder, suffix, masterReplaceString)&lt;br /&gt;   Dim strTemp&lt;br /&gt;   Dim strSearch&lt;br /&gt;   Dim objNewFolder&lt;br /&gt;   Dim objFile&lt;br /&gt;   strSearch = suffix&lt;br /&gt;   WScript.Echo "Current folder is: " &amp; objCurrentFolder.Name&lt;br /&gt;      'Recurse through all of the folders, go to bottom first&lt;br /&gt;      For Each objNewFolder In objCurrentFolder.subFolders&lt;br /&gt;              CheckFolder objNewFolder, suffix&lt;br /&gt;      Next  &lt;br /&gt;      For Each objFile In objCurrentFolder.Files&lt;br /&gt;          strTemp = Right(objFile.Name, 4)&lt;br /&gt;               If UCase(strTemp) = UCase(strSearch) Then&lt;br /&gt;                   massagePPT objFile, masterReplaceString&lt;br /&gt;               End If&lt;br /&gt;      Next  &lt;br /&gt;End Sub&lt;br /&gt;&lt;br /&gt;' ppt file filtering is done in CheckFolder, not in massagePPT&lt;br /&gt;Sub massagePPT(objFile, masterReplaceString)&lt;br /&gt;       Dim fullfile&lt;br /&gt;       fullFile = objFile.Path&lt;br /&gt;       WScript.Echo fullFile &amp; " being opened at " &amp; Now&lt;br /&gt;       Set objPresentation = objPPT.Presentations.Open(fullFile)&lt;br /&gt;       objPresentation.Designs.Load templateFile&lt;br /&gt;       With objPresentation&lt;br /&gt;           If Not .HasTitleMaster Then .AddTitleMaster&lt;br /&gt;       End With&lt;br /&gt;       EnumDesigns(objPresentation)&lt;br /&gt;       Dim MySlide&lt;br /&gt;       Dim slideNum&lt;br /&gt;       slideNum = 0&lt;br /&gt;       WScript.Echo "Presentation: " &amp; objFile.Name&lt;br /&gt;       For Each MySlide In objPresentation.Slides&lt;br /&gt;           slideNum = slideNum + 1&lt;br /&gt;           Dim text&lt;br /&gt;           Dim designName&lt;br /&gt;           designName = ""&lt;br /&gt;           With MySlide&lt;br /&gt;                   WScript.Echo "Master:" &amp; .Master.Name&lt;br /&gt;                   WScript.Echo "Design:" &amp; .Master.Design.Name&lt;br /&gt;                   designName = .Master.Design.Name&lt;br /&gt;                   WScript.Echo "SlideNum:" &amp; slideNum&lt;br /&gt;                   WScript.Echo "Layout:" &amp; .Layout&lt;br /&gt;           End With&lt;br /&gt;           ' Test if the design name is the one we want to replace&lt;br /&gt;           If InStr(1,designName,masterReplaceString) = 0 Then&lt;br /&gt;               WScript.Echo "Skipping slide " &amp; slideNum &amp; " due to non-matching master design: " &amp; designName&lt;br /&gt;           Else&lt;br /&gt;               WScript.Echo "Slide " &amp; slideNum &amp; " Master Design name matches: " &amp; masterReplaceString&lt;br /&gt;' This section controls which design elements will propagate to the target slides&lt;br /&gt;' In my case, I care mostly about the background but want to leave out master shapes and color schemes&lt;br /&gt;           With MySlide&lt;br /&gt;               .FollowMasterBackground = True&lt;br /&gt;'               .ColorScheme = objPresentation.SlideMaster.ColorScheme&lt;br /&gt;               .DisplayMasterShapes = False&lt;br /&gt;               .Design = objPresentation.Designs(newDesign)&lt;br /&gt;               End With&lt;br /&gt;           End If&lt;br /&gt;       Next&lt;br /&gt;       objPresentation.SaveAs(objFile.Path &amp; "." &amp; newDesign &amp; ".ppt")&lt;br /&gt;       objPresentation.Close&lt;br /&gt;End Sub&lt;br /&gt;      &lt;br /&gt;&lt;br /&gt;&lt;br /&gt;Sub EnumDesigns(oPres)&lt;br /&gt;   Dim lCtrA&lt;br /&gt;   With oPres&lt;br /&gt;       WScript.Echo "Number of applied templates: " &amp; .Designs.Count&lt;br /&gt;       For lCtrA = 1 To .Designs.Count&lt;br /&gt;           WScript.Echo "Template Design name: " &amp; .Designs(lCtrA).Name&lt;br /&gt;           WScript.Echo vbTab &amp; "Slide master name: " &amp; .Designs(lCtrA).SlideMaster.Name&lt;br /&gt;           If .Designs(lCtrA).HasTitleMaster Then&lt;br /&gt;               WScript.Echo vbTab &amp; "Title master name: " &amp; .Designs(lCtrA).TitleMaster.Name&lt;br /&gt;           Else&lt;br /&gt;               WScript.Echo vbTab &amp; "No Title master present"&lt;br /&gt;           End If&lt;br /&gt;       Next&lt;br /&gt;   End With&lt;br /&gt;End Sub&lt;br /&gt;&lt;br /&gt;&lt;/pre&gt;&lt;div class="blogger-post-footer"&gt;&lt;img width='1' height='1' src='https://blogger.googleusercontent.com/tracker/4782001763166047799-249403964740612232?l=snippetsandsnails.blogspot.com' alt='' /&gt;&lt;/div&gt;</content><link rel='edit' type='application/atom+xml' href='http://www.blogger.com/feeds/4782001763166047799/posts/default/249403964740612232'/><link rel='self' type='application/atom+xml' href='http://www.blogger.com/feeds/4782001763166047799/posts/default/249403964740612232'/><link rel='alternate' type='text/html' href='http://snippetsandsnails.blogspot.com/2008/08/changing-all-your-powerpoint-slides-to.html' title='Changing All Your Powerpoint Slides to a New Template'/><author><name>Dave</name><uri>http://www.blogger.com/profile/04629446239047577482</uri><email>noreply@blogger.com</email><gd:image rel='http://schemas.google.com/g/2005#thumbnail' width='16' height='16' src='http://img2.blogblog.com/img/b16-rounded.gif'/></author></entry></feed>
