I have been reading and researching for days and cannot seem to find what I am looking for. And I am close.
I have excel file and in the file are 150 different links (each in their own cell) to files on a server. Each file is a PowerPoint document (.pptx). I update my spreadsheet with a lot of different data but I want to run a macro that opens all the PowerPoint files into one PowerPoint presentation. I can generate a macro that creates a PowerPoint slide but not one that opens the files from the excel sheet I work from. Any example codes would be helpful. I am close but yest so far away. :)

Thanks

Marty

So I have a idea or game plan I posted below if anyone can look at it and help me with this project.

Excel sheet has 5 cells (A1:A5) with hyperlinks (c:/documents/test.pptx) to PowerPoint slides on a server.

I would like to automate them (all 5 slides) to open in to one PowerPoint Project/Presentation.

Here is the code I am currently working on:

Sub CreatePowerPoint()

'Add a reference to the Microsoft PowerPoint Library by:
'1. Go to Tools in the VBA menu
'2. Click on Reference
'3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay

'First we declare the variables we will be using
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
Dim c As Range

'Look for existing instance
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0

'Let's create a new PowerPoint
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
'Make a presentation in PowerPoint
If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If

'Show the PowerPoint
newPowerPoint.Visible = True

'Add a new slide where we will open the file (hyperlink)
newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPo int.ActivePresentation.Slides.Count)

'But this is where I am stuck. I need to open the hyperlinks and have them inserted into the slides. Or create the slides. The files are slides.


Next

AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing

End Sub

I have been reading and researching for days and cannot seem to find
what I am looking for. And I am close. I have excel file and in the
file are 150 different links (each in their own cell) to files on a
server. Each file is a PowerPoint document (.pptx). I update my
spreadsheet with a lot of different data but I want to run a macro
that opens all the PowerPoint files into one PowerPoint presentation.
I can generate a macro that creates a PowerPoint slide but not one
that opens the files from the excel sheet I work from. Any
example codes would be helpful. I am close but yest so far away. :)

Thanks

Marty

I think you're going about this entirely wrong!!
I read your code and I'm curious as to why you're not doing this in a
PowerPoint VBA project! You could read the files list without having to
open the Excel file (using ADODB) into VBA there and process the entire
task in PP. Easier yet, store the list in a txt file and use standard
VBA file I/O functions to read the file into an array, then loop to get
each file.

But.., if you insist on doing this in Excel then...

Add another variable of Variant type, and a counter for the loop:

Dim vList, n&

'Dump the list into an array
vList = ActiveSheet.Range("A1:A5")
'Iterate the array to process each list item
For n = LBound(vList) To UBound(vList)
Debug.Print vList(n, 1) '//process each file here
Next 'n

...where vList is a 2D array consisting of 5 rows and 1 col.

Note that best practice in VBA programming recommends *'NEVER hijack an
existing instance'* of an app for automation. (Exception is Outlook
because it doesn't allow multiple instances!)

Now I've never automated PP but reading its Object ref I suspect you
could revise your Excel code like so...

Sub CreatePowerPoint()
Dim vList, n&

vList = ActiveSheet.Range("A1:A5")
On Error GoTo Cleanup
'Automate a new instance of PowerPoint
With CreateObject("PowerPoint.Application")
'Make a presentation in PowerPoint
.Visible = True

For n = LBound(vList) To UBound(vList)
'Add a new slide from the file
With .Presentations.Add
'Insert the slide into the presentation
.slides.InsertFromFile vfile(n, 1), .slides.Count + 1
End With '.Presentations.Add
Next 'n
End With 'CreateObject
Cleanup:
End Sub

...to simplify the process

But I think you'd be better off doing a PP project and store the slides
list in a text file. That means you'll need to persue this in a PP
group. In this case the following revised Excel code should work...


Sub InsertSlidesFromFile()
' Inserts slides from a list of PPTs stored in a txt file
Dim vList, n&

vList = Split(ReadTextFile("C:\documents\TestPP.txt"), vbCrLf)
On Error GoTo Cleanup
With Application
For n = LBound(vList) To UBound(vList)
'Add a new slide from the file
With .Presentations.Add
'Insert the slide into the presentation
.slides.InsertFromFile vfile(n), .slides.Count + 1
End With '.Presentations.Add
Next 'n
End With 'Application
Cleanup:
End Sub

Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in one single step.
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum)

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()

Optionally, if your slide files are the only files stored in a specific
folder then you could also drill that folder with VBA's Dir() function
to access each file without the need for the 'ReadTextFile' helper
routine...

Sub InsertSlidesFromFolder()
' Inserts slides from a list of PPTs stored in a txt file
Dim vFile, n&

vFile = Dir("C:\documents\*.*", vbDirectory)
On Error GoTo Cleanup
With Application
Do While Len(vFile)
'Add a new slide from the file
With .Presentations.Add
'Insert the slide into the presentation
.slides.InsertFromFile vFile, .slides.Count + 1
End With '.Presentations.Add
vFile = Dir()
Loop
End With 'Application
Cleanup:
End Sub

HTH

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

I forgot to include the path and so 'InsertSlidesFrom...' routines are
revised as follows...

Sub InsertSlidesFromFile()
' Inserts slides from a list of PPTs stored in a txt file
Dim vList, n&
Const sPath$ = "C:\documents\"

vList = Split(ReadTextFile(sPath & "TestPP.txt"), vbCrLf)
On Error GoTo Cleanup
With Application
For n = LBound(vList) To UBound(vList)
'Add a new slide where we will open the file (hyperlink)
With .Presentations.Add
'Insert the files into the slide
.slides.InsertFromFile sPath & vFile(n), .slides.Count + 1
End With '.Presentations.Add
Next 'n
End With 'Application
Cleanup:
End Sub

Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in one single step.
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum)

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()

Sub InsertSlidesFromFolder()
' Inserts slides from a list of PPTs stored in a txt file
Dim vFile, n&
Const sPath$ = "C:\documents\"

vFile = Dir(sPath)
On Error GoTo Cleanup
With Application
Do While Len(vFile)
'Add a new slide from the file
With .Presentations.Add
'Insert the slide into the presentation
.slides.InsertFromFile sPath & vFile, .slides.Count + 1
End With '.Presentations.Add
vFile = Dir()
Loop
End With 'Application
Cleanup:
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Note that if the path is included in the txt file list then use this
version...


Sub InsertSlidesFromFile()
' Inserts slides from a list of PPTs stored in a txt file
Dim vList, n&
Const sPath$ = "C:\documents\"

vList = Split(ReadTextFile(sPath & "TestPP.txt"), vbCrLf)
On Error GoTo Cleanup
With Application
For n = LBound(vList) To UBound(vList)
'Add a new slide where we will open the file (hyperlink)
With .Presentations.Add
'Insert the files into the slide
.slides.InsertFromFile vFile(n), .slides.Count + 1
End With '.Presentations.Add
Next 'n
End With 'Application
Cleanup:
End Sub

Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in one single step.
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum)

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

This is great info. I did not think of the other side of the spectrum and using Excel as a database tool. DUH. I cant believe I didnt think of this. Since you spent some time helping me with the excel VBA I will play with it now and post some results. But I think you are right and if I did it through PPT then it could be much simpler. Thanks.

This is great info. I did not think of the other side of the
spectrum and using Excel as a database tool. DUH. I cant believe I
didnt think of this. Since you spent some time helping me with the
excel VBA I will play with it now and post some results. But I think
you are right and if I did it through PPT then it could be much
simpler. Thanks.

You're welcome!
Note that I gave you *both* Excel and PPT code. The 2
'InsertSlidesFrom...' subs are PPT. The 'CreatePowerPoint' is Excel.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

The entire module partially works. If I run Sub CreatePowerPoint it generates a PowerPoint presentation but it does not insert the slides form the hyperlinks in the excel sheet. Same with InsertSlidesFromFile. Any thoughts. We are so close.

I did have to add Dim vFile as I was getting some errors. So here is the new module:

Option Explicit

Const sPath$ = "C:\Users\marty\Documents\"

Sub CreatePowerPoint()
Dim vList, n&
Dim vFile

vList = ActiveSheet.Range("A1:A5")
On Error GoTo Cleanup
'Automate a new instance of PowerPoint
With CreateObject("PowerPoint.Application")
.Visible = True
'Add a new presentation
With .Presentations.Add
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.slides.InsertFromFile vFile(n, 1), .slides.Count + 1
Next 'n
End With '.Presentations.Add
End With 'CreateObject
Cleanup:
End Sub

Sub InsertSlidesFromFile()
' Inserts slides from a list of PPTs stored in a txt file
Dim vList, n&
Dim vFile

vList = Split(ReadTextFile(sPath & "auto.txt"), vbCrLf)
On Error GoTo Cleanup
'Add a new presentation
With Application.Presentations.Add
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.slides.InsertFromFile sPath & vFile(n), .slides.Count + 1
Next 'n
End With 'Application.Presentations.Add
Cleanup:
End Sub

Sub InsertSlidesFromFolder()
' Inserts slides from a list of PPTs stored in a txt file
Dim vFile, n&

vFile = Dir(sPath)
On Error GoTo Cleanup
'Add a new presentation
With Application.Presentations.Add
'Insert the slides into the presentation
Do While Len(vFile)
.slides.InsertFromFile sPath & vFile, .slides.Count + 1
vFile = Dir()
Loop
End With 'Application.Presentations.Add
Cleanup:
End Sub

Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in one single step.
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum)

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()

Sorry.., my bad copy/paste. Should be...

Sub CreatePowerPoint()
Dim vList, n&

vList = ActiveSheet.Range("A1:A5")
On Error GoTo Cleanup
'Automate a new instance of PowerPoint
With CreateObject("PowerPoint.Application")
.Visible = True
'Add a new presentation
With .Presentations.Add
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.slides.InsertFromFile vList(n, 1), .slides.Count + 1
Next 'n
End With '.Presentations.Add
End With 'CreateObject
Cleanup:
End Sub

Sub InsertSlidesFromFile()
' Inserts slides from a list of PPTs stored in a txt file
Dim vList, n&

vList = Split(ReadTextFile(sPath & "auto.txt"), vbCrLf)
On Error GoTo Cleanup
'Add a new presentation
With Application.Presentations.Add
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.slides.InsertFromFile sPath & vList(n), .slides.Count + 1
Next 'n
End With 'Application.Presentations.Add
Cleanup:
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

no worries,

I fixed the copy and paste part but I am still not getting the slides to come up when running CreatePowerPoint. And now when I run InserSlidesFromFile nothing happens. Weird.

no worries,

I fixed the copy and paste part but I am still not getting the slides
to come up when running CreatePowerPoint. And now when I run
InserSlidesFromFile nothing happens. Weird.

This is where you need to get help in a PPT forum...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

I am already on it. :) We are close, but missing a open hyperlink function of some sort.

I am thinking of something like this would work with the

..objPPT.Presentations.Open


Some sample code:

Dim objPPT As Object

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

objPPT.Presentations.Open "\\ServerName\FileName.pptx"

I started a thread in the MS EXCEL and VBA MACROS group. My post in their group has a sample folder with all necessary files. here is a link to test and play with it. Thanks.

https://groups.google.com/forum/#!to...os/-ZintzqwKD8

I started a thread in the MS EXCEL and VBA MACROS group. My post in
their group has a sample folder with all necessary files. here is a
link to test and play with it. Thanks.

https://groups.google.com/forum/#!to...os/-ZintzqwKD8

Got it working with the followig code...

Option Explicit

Sub CreatePPT()
Dim vList, n&, oPres

vList = ActiveSheet.Range("A1:A5")
On Error GoTo Cleanup
'Automate a new instance of PowerPoint
' Set appPPT = CreateObject("PowerPoint.Application")
With CreateObject("PowerPoint.Application") 'appPPT
'Add a new presentation
Set oPres = .Presentations.Add
With oPres.slides
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.InsertFromFile vList(n, 1), .Count
Next 'n
End With 'oPres.slides
.Visible = True
End With 'CreateObject
Cleanup:
Set oPres = Nothing
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

I started a thread in the MS EXCEL and VBA MACROS group. My post in
their group has a sample folder with all necessary files. here is a
link to test and play with it. Thanks.

https://groups.google.com/forum/#!to...os/-ZintzqwKD8

Got this code working in PPT...

Option Explicit


Sub InsertSlidesFromFile()
' Inserts slides from a list of PPTs stored in a txt file
Dim vList, n&, oPres, oDlg, vFile, sFile$

Set oDlg = Application.FileDialog(msoFileDialogOpen)
With oDlg.Show
On Error Resume Next
vFile = oDlg.SelectedItems(1)
On Error GoTo 0
End With
sFile = IIf(vFile = Empty, "", CStr(vFile))
If sFile = "" Then goto cleanup

vList = Split(ReadTextFile(sFile), vbCrLf)
On Error GoTo Cleanup
'Add a new presentation
Set oPres = Presentations.Add
With oPres.Slides
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.InsertFromFile vList(n), .Count
Next 'n
End With 'oPres.slides

Cleanup:
Set oDlg = Nothing: Set oPres = Nothing
End Sub

Sub InsertSlidesFromFolder()
' Inserts slides from a list of PPTs stored in a txt file
Dim vFile, n&, oPres, sPath$

sPath = GetDirectory: If sPath = "" Then Exit Sub
sPath = IIf(Right(sPath, 1) < "\", sPath & "\", sPath)

vFile = Dir(sPath)
On Error GoTo Cleanup
'Add a new presentation
Set oPres = Presentations.Add
With oPres.Slides
'Insert the slides into the presentation
Do While Len(vFile)
.InsertFromFile sPath & vFile, .Count
vFile = Dir()
Loop
End With 'oPres.slides

Cleanup:
Set oPres = Nothing
End Sub

Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in one single step.
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum)

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()

Function GetDirectory$(Optional OpenAt, Optional Msg$)
' Returns the path of a user selected folder
' Note: By default, dialog opens at 'Desktop'
' Args:
' OpenAt Optional: Path to the dialog's top level folder
' Msg Optional: The dialog's title

If Msg = "" Then Msg = "Please choose a folder"
On Error Resume Next '//if user cancels
GetDirectory = CreateObject("Shell.Application").BrowseForFolder( 0,
Msg, &H40 Or &H10, OpenAt).Self.Path
End Function 'GetDirectory()

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Opps, I forgot the code:

Sub Dead_Hyperlinks()
' Find Dead Hyperlinks
Dim c As Range

'CHANGE - Here you will need to change the name of the worksheet you want and the range of cells to check
For Each c In Worksheets("Links").Range("J2:J105") 'Change range to suit

If c.Value = "" Then End

If FileExists(c.Hyperlinks(1).Address) = "False" Then

With c.Interior 'Color cell with dead link Yellow
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
End With

End If
Next

MsgBox "Check Complete"

End Sub

Function FileExists(PathName As String) As Boolean

Dim Temp As Integer

On Error Resume Next 'Ignore errors

Temp = GetAttr(PathName)

Select Case Err.Number 'Check if error exists and set response
Case Is = 0
FileExists = True
Case Else
FileExists = False
End Select

On Error GoTo 0 'Resume error checking


End Function

Okay, after spending a few days playing with the code and tweaking my files and organization a bit, this is what I have come up with.
What is needed and what is my process:

The Objective: Create a Power Point Presentation from 150 individual power point slides that are located on different servers. And to make sure that these files have a valid address with the option to change the address upon finding a broken link.

1. Each file is a PowerPoint slide that has its own unique address. (\\nwserver\data\folder xx\ slide1.pptx).

2. Each file is in a different folder and these files are updated by engineers on a daily basis.

3. Each file's address is saved in a excel sheet (A1:A150) that I manually update when new ones are made and old ones are removed.

4. Sometimes these files get renamed/moved to a different location and then it creates a broken address (hyperlink).

The outcome of this is that I need to generate a presentation a few times a week and right now it is manual. It takes hours if not days depending on the changes.

So far this code works with my current excel sheet:

Option Explicit
Sub Auto()

Dim vList, n&, oPres

vList = ActiveSheet.Range("A1:A5")
On Error GoTo Cleanup
'Automate a new instance of PowerPoint
' Set appPPT = CreateObject("PowerPoint.Application")
With CreateObject("PowerPoint.Application") 'appPPT
'Add a new presentation
Set oPres = .Presentations.Add
With oPres.slides
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.InsertFromFile vList(n, 1), .Count
Next 'n
End With 'oPres.slides
.Visible = True
End With 'CreateObject
Cleanup:
Set oPres = Nothing
End Sub


It does exactly what it needs to do by opening up cells A1:A5 and reads the address that is located in each cell... (\\nwserver\data\folder xx\ slide1.pptx)

It then produces a PowerPoint presenation with the slides in order as they are in the excel sheet.

What it does not do:

It does not find the Broken Links first and then creates a text box to the new location for that file. What happens is it stops showing the next slides in the presentation when one of the links is broken.

Also, if a individual slide has formatting it does not show up in the processed PowerPoint presentation. Its as if it does not load the formatting for the slides.

So next steps would be to:

incorporate my macro for checking the links into the new code:

Sub FourSQ_Dead_Hyperlinks()
' Find Dead Hyperlinks
Dim c As Range

'CHANGE - Here you will need to change the name of the worksheet you want and the range of cells to check
For Each c In Worksheets("4SQ Links").Range("J2:J114") 'Change range to suit

If c.Value = "" Then End

If FileExists(c.Hyperlinks(1).Address) = "False" Then

With c.Interior 'Color cell with dead link Yellow
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
End With

End If
Next

MsgBox "Check Complete"

End Sub

Function FileExists(PathName As String) As Boolean

Dim Temp As Integer

On Error Resume Next 'Ignore errors

Temp = GetAttr(PathName)

Select Case Err.Number 'Check if error exists and set response
Case Is = 0
FileExists = True
Case Else
FileExists = False
End Select








In the above code a change would need to be made to incorporate a text box that allows a folder/file search to change the location of the dead link.

So now the new code would look something like this:

Sub CheckThenAuto()

' Find Dead Hyperlinks
Dim c As Range
Dim vList, n&, oPres

'CHANGE - Here you will need to change the name of the worksheet you want and the range of cells to check
For Each c In Worksheets("Sheet1").Range("A1:A5") 'Change range to suit

If c.Value = "" Then End

If FileExists(c.Hyperlinks(1).Address) = "False" Then

With c.Interior 'Color cell with dead link Yellow
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
End With

End If
Next

MsgBox "Check Complete"

vList = ActiveSheet.Range("A1:A5")
On Error GoTo Cleanup
'Automate a new instance of PowerPoint
' Set appPPT = CreateObject("PowerPoint.Application")
With CreateObject("PowerPoint.Application") 'appPPT
'Add a new presentation
Set oPres = .Presentations.Add
With oPres.slides
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.InsertFromFile vList(n, 1), .Count
Next 'n
End With 'oPres.slides
.Visible = True
End With 'CreateObject
Cleanup:
Set oPres = Nothing

End Sub

Function FileExists(PathName As String) As Boolean

Dim Temp As Integer

On Error Resume Next 'Ignore errors

Temp = GetAttr(PathName)

Select Case Err.Number 'Check if error exists and set response
Case Is = 0
FileExists = True
Case Else
FileExists = False
End Select

End Function


It needs a little work as the links are highlighted yellow. LOL but I am working on that now.


The next steps would be to add the text box and save keel the PowerPoint formatting while opening and inserting the files into the presentation.

Maybe the logic would look something like this: Original slide1.ppt file then Copy it and paste it into the presentation. Or paste special of some sort.

Keeping the formatting is the biggest set back right now.

Thanks for looking and the input.

IMO, Marty, you're way over complicating! The following checks the list
for valid paths and if not found then prompts to locate the correct
path. This should result in a list of valid paths so long as the
correct path is found.

If the correct path IS found then the list is updated with the new
value. Otherwise, the routine ends after notifying the user to update
the list and try again...

Option Explicit

Sub CreatePPT()
Dim vList, n&, oPres, vPath
Dim rngSource As Range

'Edit to suit...
Const sTitle$ = "Select the correct location for this file"
Const sMsgFail$ = "Valid paths are required!" _
& vbLf & vbLf _
& "Please revise the list and try again."

Set rngSource = Selection '//edit to suit
vList = rngSource

'Ensure valid paths
For n = LBound(vList) To UBound(vList)
If Not bFileExists(vList(n, 1)) Then
'Prompt for the correct path
vPath = Application.GetSaveAsFilename(vList(n, 1), , , sTitle)
'If found, update the list
If Not vPath = False Then
vList(n, 1) = vPath: rngSource = vList
Else
MsgBox sMsgFail: Exit Sub
End If 'Not vPath = False
End If 'Not bFileExists
Next 'n

On Error GoTo Cleanup
'If we got here then we have a valid paths,
'so automate a new instance of PowerPoint
With CreateObject("PowerPoint.Application") 'appPPT
'Add a new presentation
Set oPres = .Presentations.Add
With oPres.slides
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.InsertFromFile vList(n, 1), .Count
Next 'n
End With 'oPres.slides
.Visible = True
End With 'CreateObject
Cleanup:
Set oPres = Nothing: Set rngSource = Nothing
End Sub


Function bFileExists(Filename) As Boolean
' Checks if a file exists in the specified path
' Arguments: Filename (Variant) The fullname of the file
' Returns: TRUE if the file exists

On Error Resume Next
bFileExists = (Dir$(Filename) < "")
' bFileExists = (FileLen(Filename) < 0) '//optional method
End Function

To run your FourSQ_Dead_Hyperlinks routine on any sheet just activate
the sheet and select the range to 'flag'...

Sub FourSQ_Dead_Hyperlinks()
' Find Dead Hyperlinks
Dim c As Range

For Each c In Selection
If len(c.Value) and Not bFileExists(c.Value) Then _
c.Interior.Color = 65535
Next
MsgBox "Check Complete"
End Sub

...whch gives you the option to choose non-contiguous cells.

I can't assist you with the slide format issue. (As far as I see.., the
presentation inserts the sample slides "as is" in terms of how they
open in PPT individually!)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

You might want to put some emphasis on this...

MsgBox sMsgFail, vbCritical: Exit Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

Thanks again Garry,

I will play with it a bit this week and post some results.

Garry,

The new code works great and I am working on the formatting issue. The only thing I would ask for help with now... is that when I ran the GARRY code with 150 cell sheet and it found an error (broken link), there is no way to know which file it is referring to for the error. I think that if it highlighted the field and the message box came up then it would be a much easier to fix. Or any other thoughts would be great. I am trying to insert: Interior.Color = 65535 to highlight the color but I keep getting an object error. Any thoughts? Guru Garry. You have been a huge help in this project as well as in my learning. Thanks man.

Marty