[Marty Girvan]

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

[Marty Girvan]

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

[GS[_2_]]

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

[GS[_2_]]

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

[GS[_2_]]

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

[Marty Girvan]

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.

[GS[_2_]]

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

[Marty Girvan]

Thanks again. I started working from the PPT macro first as it makes more sense. However, I am running into a issue. I created a txt file that only contains a list of paths for all the files (150 files. The files are stored in different locations throughout the server. The txt file only contains the file paths. Here is my (your) code:



Sub auto()

' Inserts slides from a list of PPTs stored in a txt file
Dim vList, n&
Dim vFile
Const sPath$ = "C:\Users\Marty\Documents"

'auto.txt is the file with the hyperlinks
vList = Split(ReadTextFile(sPath & "auto.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()


I am getting a File Not Found when I debug. The argument looks valid but i am not sure why it is not finding the file. The error is on line 53' which is this line of code:

" Close #iNum: If Err Then Err.Raise , Err.Number, , Err.Description"

Any thoughts.

Also, I did play with the excel code a bit and it generates the PowerPoint presentation and the first slide, but it does not open the files. Here is the code I using:

Sub Run()
Dim vList, n&
Dim vFile

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



Thanks again. I would like to try and get both the excel code working and the PPT code so that I can hand some of these projects over to others for them to run and can automate some of the daily processes. Thanks again, it is much appreciated and fun to learn. :)

Marty

[GS[_2_]]

Thanks again. I started working from the PPT macro first as it makes
more sense. However, I am running into a issue. I created a txt
file that only contains a list of paths for all the files (150 files.
The files are stored in different locations throughout the server.
The txt file only contains the file paths...

The intent of using the text file is so it works with files stored in
different locations, as would the hyperlinks on your worksheet. You say
your text file "only contains a list of 'paths'", but should also
include the filename.

Also, your sPath constant does not end with a backslash and so this
posted code is looking for a file named...

"Documentsauto.txt"
IN
"C:\User\Marty\"

...when it should be looking for...

"auto.txt"
IN
"C:\User\Marty\Documents\"

--
Garry

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

[GS[_2_]]

Also, I did play with the excel code a bit and it generates the
PowerPoint presentation and the first slide, but it does not open the
files

As I mentioned.., I don't work with PPT and so any code relating to it
should be asked in a PPT group. That said, after looking at the code it
appears to create a new Presentation for each file when what I think
you want is 1 presentation consisting of slides inserted from the
source files...

'[XL routine]
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
For n = LBound(vList) To UBound(vList)
'Insert the files into the slide
.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&
Const sPath$ = "C:\documents\"

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

'[PPT routines]
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
'Add a new presentation
With Application.Presentations.Add
Do While Len(vFile)
'Insert the slide into the presentation
.slides.InsertFromFile sPath & vFile, .slides.Count + 1
vFile = Dir()
Loop
End With 'Application.Presentations.Add
Cleanup:
End Sub

Sub ReformatBankAmounts()
Dim c As Range
For Each c In Selection
c = Format(c / 1000, "000.000")
Next 'c
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

[GS[_2_]]

Please revise sPath to your actual folder location...

"C:\Users\Marty\Documents\"

--
Garry

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

[GS[_2_]]

Oops.., too many subs AND properly located section marker for PPT
subs...

'[XL routine]
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
For n = LBound(vList) To UBound(vList)
'Insert the files into the slide
.slides.InsertFromFile vFile(n, 1), .slides.Count + 1
Next 'n
End With '.Presentations.Add
End With 'CreateObject
Cleanup:
End Sub

'[PPT routines]
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
'Add a new presentation
With Application.Presentations.Add
For n = LBound(vList) To UBound(vList)
'Insert the files into the slide
.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&
Const sPath$ = "C:\documents\"

vFile = Dir(sPath)
On Error GoTo Cleanup
'Add a new presentation
With Application.Presentations.Add
Do While Len(vFile)
'Insert the slide into the presentation
.slides.InsertFromFile sPath & vFile, .slides.Count + 1
vFile = Dir()
Loop
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

[Marty Girvan]

I see the missing backslash. My apologies. I will update and run. another apology as I misstated the info about the txt file and the paths of the files. They are all full path names with the file extensions. Same with the Excel file. Ill work on these and update. Cheers for the quick response.

[GS[_2_]]

Here's all new code for the entire module...

Option Explicit

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

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 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&

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()

--
Garry

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

[Marty Girvan]

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()

[GS[_2_]]

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

[Marty Girvan]

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.

[GS[_2_]]

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

[Marty Girvan]

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

[Marty Girvan]

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"

[Marty Girvan]

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

[GS[_2_]]

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

I don't understand why you think you need hyperlinks. Everything I
coded for just requires a full path...

--
Garry

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

[GS[_2_]]

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

[GS[_2_]]

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

[isabelle]

hi,

Le 2014-08-27 13:38, Marty Girvan a écrit :
I am already on it. :) We are close, but missing a open hyperlink function of some sort.

Sub appPPT()
Dim oPPT As PowerPoint.Application
Dim oPres As PowerPoint.Presentation
Dim oSlide As PowerPoint.Slide
Dim oShape As PowerPoint.Shape

Set oPPT = CreateObject("PowerPoint.Application")
Set oPres = oPPT.Presentations.Add(msoTrue)
Set oSlide = oPres.Slides.Add(1, ppLayoutBlank)
Set oShape = oSlide.Shapes.AddTextbox(msoTextOrientationHorizon tal, 10, 10, 256, 28)

With oShape.TextFrame.TextRange
.Text = "http//www.google.com"
.ActionSettings(ppMouseClick).Hyperlink.Address = "http://www.google.com/"
End With

oPPT.Visible = msoTrue
End Sub

isabelle

[isabelle]

note that the Hyperlinks work only while a slide show presentation is running —
not while you're working on your presentation in normal view or slide sorter view

isabelle

Le 2014-08-27 22:13, isabelle a écrit :
hi,

Le 2014-08-27 13:38, Marty Girvan a écrit :
I am already on it. :) We are close, but missing a open hyperlink function
of some sort.

Sub appPPT()
Dim oPPT As PowerPoint.Application
Dim oPres As PowerPoint.Presentation
Dim oSlide As PowerPoint.Slide
Dim oShape As PowerPoint.Shape

Set oPPT = CreateObject("PowerPoint.Application")
Set oPres = oPPT.Presentations.Add(msoTrue)
Set oSlide = oPres.Slides.Add(1, ppLayoutBlank)
Set oShape = oSlide.Shapes.AddTextbox(msoTextOrientationHorizon tal, 10, 10, 256,
28)

With oShape.TextFrame.TextRange
.Text = "http//www.google.com"
.ActionSettings(ppMouseClick).Hyperlink.Address = "http://www.google.com/"
End With

oPPT.Visible = msoTrue
End Sub

isabelle

[Marty Girvan]

My apologies as I have been in a training till now. I am going to integrate your code, Gary and Isabella. I am excited to try it. Thanks. I'll post my results.

[Marty Girvan]

Isabella,


Thank you for the code and reply. Looking a the code, I think it misses the idea of automating the hyperlinks opening automatically from a excel file.. If I understand your code correctly, then I would need to add all 150 links to the code. Let me know if this is what you are referring to. Thanks again.

Marty

[isabelle]

hi Marty,

do you want add to your presentation a link to view the excel file that contains
file links (pptx)

With oShape.TextFrame.TextRange
.Text = "PPTX Links Address"
With .ActionSettings(ppMouseClick).Hyperlink
.Address = "C:\Users\isabelle\PPTX Links Address.xlsm"
.SubAddress = "Sheet2!A1"
End With
End With

or do you want add these links directly in your presentation (150 textbox)

isabelle

Le 2014-08-29 19:57, Marty Girvan a écrit :

Isabella,


Thank you for the code and reply. Looking a the code, I think it misses the idea of automating the hyperlinks opening automatically from a excel file.
If I understand your code correctly, then I would need to add all 150 links to
the code. Let me know if this is what you are referring to. Thanks again.

Marty

[Marty Girvan]

Isabelle,

I have a excel file with 150 hyperlinks (A1:A150). Each hyperlink points to a single PowerPoint slide. Each slide is in a different folder on different servers. These files ate updated daily by engineers. I need to find a way to open them all and have them automatically build a presentation with all 150 slides so that I can present it on a weekly basis. If you read through all the above posts. There is more detailed info as to how we are trying to build this VBA code. Thanks again for taking the time to problem solve and help create. Its fun.

Marty

[Marty Girvan]

I was able to get both the excel code to work and the PowerPoint code to work. However, I found that if a link is missing or broken the code will only show the slides till the broken/missing link. We need something that will check all the links first and highlight the ones that ate broken, then maybe a text box that asks to compile and generate the presentation. This way you can fix the links first (highlighted) and then compile.

Here is the code I currently use to check the links.

[Marty Girvan]

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

[GS[_2_]]

Isabelle,

I have a excel file with 150 hyperlinks (A1:A150). Each hyperlink
points to a single PowerPoint slide. Each slide is in a different
folder on different servers. These files ate updated daily by
engineers. I need to find a way to open them all and have them
automatically build a presentation with all 150 slides so that I can
present it on a weekly basis. If you read through all the above
posts. There is more detailed info as to how we are trying to build
this VBA code. Thanks again for taking the time to problem solve and
help create. Its fun.

Marty

The code samples I posted do *exactly* what you want both from Excel
and PPT if your list items point to UNC paths...

(ie: "//server/share/folder/file".

The code shows various ways to open all the files in a list stored in a
spreadsheet, text file, or individual folders.

The hardest part for me was not having any experience using PPT! (I can
make same presentations in Excel<g, so no need to learn a different
software IMO! Same goes for Word!) But after you posted the download
link to sample files things just quickly 'fell together'!

What it does not do is download the fikes from the internet. That's
easy to do in VB[A], however, by just setting some references to the
necessary system DLLs to get it done.

You are (typically) piece-mealing us bits of your task requirements 'as
you go' and so 'it goes' that eventually things will come together once
all (or nearly all) of the requirements are known. For example.., the
samples' list hyperlinks to files stored locally, NOT across multiple
servers. None of my code requires 'hyperlinks' because it accesses
files directly via fully qualified paths. Download URLs aren't
hyperlinks either, ..they're just location paths to the files.

IMO, persisting to go on and on about trying to work with hyperlinks is
a deterring distraction away from getting a speady solution. The code
you posted for checking if a path/file is valid is normal practice for
accessing files. (Not to mention there's better ways to do it as well!)

Give us 'the goods, the whole goods, and nuthin' but the goods' and
we'll do our best to get you a good working solution!!!

--
Garry

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

[Marty Girvan]

Garry,

Thanks again. I am back from Vaca and working on this again. No internet where I was at. Anyhow, I am still playing with the process and code and will update again tomorrow with some more info. I may send you my working folder if I can find the time and you can see where I am at. Thanks again. Cheers.

[Marty Girvan]

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.

[GS[_2_]]

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

[GS[_2_]]

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

[Marty Girvan]

Thanks again Garry,

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

[Marty Girvan]

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

[GS[_2_]]

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

The filename should be displayed as the 'InitialFilename' in the browse
dialog when the listed file does not exist! What else do you need to
know?

--
Garry

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