Automation from Access

A

Adam Milligan

All-

I am designing an application in Access 2003. What I woul dlike to do
through VBA is open a new, blank powerpoint presentation, add slides to the
presentation from four or five saved presentations and save the new
prentation. I already have the code that will loop through the filepaths of
the presentations I want to add, and I think I have opend up a new
presentation. Here is the code I have

Dim ppt As PowerPoint.Application
Dim pres As PowerPoint.Presentation

Set ppt = CreateObject("PowerPoint.Application")
Set pres = ppt.Presentations.Add

Do While recPowerPoint.EOF = False 'recPowerPoint is a recordset with the
file names I want to add

sFile = sFilePath & recPowerPoint("strTitle") & ".ppt" 'sFilePath is a user
defined variable for wherever they want to save the ppt files

ActivePresentation.Slides.InsertFromFile sFile, 1 'This is where I am
getting the error

recPowerPoint.MoveNext

Loop

ActivePresentation.SaveAs "c:/New.ppt"

Like I said, I get an error "ActiveX component can't create object" On the
ActivePresntation.Slides.InsertFromFile part of the code. I am new to
PowerPoint VBA nad any help would be appreciated. Thanks

Adam
 
A

Adam Milligan

All-

I did some more digging and solved my own problem. For those interested,
here is my hack solution:

Public Sub PowerPnt()

Dim recPowerPoint As Recordset
Dim sFilePath As String
Dim numService As Integer
Dim sql As String
Dim sFile As String
Dim ppt As PowerPoint.Application
Dim pres As PowerPoint.Presentation

numService = Forms!frmWorshipServiceInfo.anuServiceID 'get the servie ID
from the user form
sFilePath = Forms!frmHome.strPowerPointFilepath 'get the Power Point
filepath from the userform

Set ppt = CreateObject("PowerPoint.Application") 'create an instance of
Powerpoint
Set pres = ppt.Presentations.Add 'create a new presentation

sql = "SELECT * FROM qryPowerPoint WHERE numService = " & numService & "
ORDER BY numOrder DESC" 'create SQL that will get only the songs

'from the desired service, sorted DESC since

' slides are added at the beginning
Set recPowerPoint = CurrentDb.OpenRecordset(sql) 'open recordset from SQL
above

Do While recPowerPoint.EOF = False
sFile = sFilePath & recPowerPoint("strTitle") & ".ppt" 'create the entire
filepath including the Title of the song

If Not Dir$(sFile) <> "" Then 'if the file does not exist, tell the user and
move to the next record
MsgBox "The file " & sFile & " could not be found and was not added."
recPowerPoint.MoveNext

Else

With pres 'if the file does exist, insert all of the slides from that
presentation into the new one
..Slides.InsertFromFile sFile, 0
End With

recPowerPoint.MoveNext

End If

Loop

With pres
.SaveAs sFilePath & "New.ppt" 'save the file in the same directory as the
songs
End With

End Sub

If you see any problems with this code please let me know. The one problem
I am having is that it does not import the backgrounds as well. Does anyone
know how I would do that?

Adam Milligan
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top