We have alot of PowerPoint slideshows, and I've been working on a program (originally with some sample code from MS) to take a slideshow and save the slides using the slide title as filename to M-Files so we can build a library.
Program isn't as efficient as it could be as I'm saving to local disk first, then re-saving to M-Files using the "unclassified" class - how would I go about specifying a document class?
' Add 'Class' property
Dim oPropertyValue2 As MFilesAPI.PropertyValue = New MFilesAPI.PropertyValue
oPropertyValue2.PropertyDef = MFilesAPI.MFBuiltInPropertyDef.MFBuiltInPropertyDefClass
oPropertyValue2.TypedValue.SetValue(MFilesAPI.MFDataType.MFDatatypeLookup, _
MFilesAPI.MFBuiltInDocumentClass.MFBuiltInDocumentClassUnclassifiedDocument)
oPropertyValues.Add(1, oPropertyValue2)
Here is entire sub routine:-
Private Sub cmdSplitSlides_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdSplitSlides.Click
Dim myStream As Stream = Nothing
Dim ShowCounter, i, ExportCounter, NumberOfSlides, ReverseCounter, intCounter, intAttempts, strSuccess As Integer
Dim strCopyFile, strNewFileName, strWorkingFileName, strWorkingFolder, SlideName, ErrorMessage, strExtension As String
' Make the user select which file to work with ############################################
Dim openFileDialog1 As New OpenFileDialog()
openFileDialog1.InitialDirectory = Me.WorkingFilename.Text
openFileDialog1.Filter = "PowerPoint |*.ppt;*.pptx"
openFileDialog1.RestoreDirectory = True
' Only proceed when the user selects a file to work with ##################################
If openFileDialog1.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
Try
myStream = openFileDialog1.OpenFile()
If (myStream IsNot Nothing) Then
strCopyFile = openFileDialog1.FileName
End If
Catch Ex As Exception
MessageBox.Show("Error - Cannot read file from disk. Error message: " & Ex.Message)
Finally
' Check this again, since we need to make sure we didn't throw an exception on open.
If (myStream IsNot Nothing) Then
myStream.Close()
End If
End Try
' Find out the file extension - important for M-Files #################################
If (Strings.Right(strCopyFile, 1)) = "t" Then
strExtension = "ppt"
Else
strExtension = "pptx"
End If
' String together full path and filename and open file to edit ########################
strWorkingFolder = BulkFolder.Text
strWorkingFileName = WorkingFilename.Text
strNewFileName = strWorkingFolder & "\" & strWorkingFileName & "." & strExtension
intAttempts = 10
strSuccess = False
ShowCounter = 0
ExportCounter = 1
Try
objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Catch Ex As Exception
' This is a fatal error
MsgBox("Error - There was a problem opening PowerPoint. Error message: " & Ex.Message)
GoTo ExitError
End Try
Try
objPres = objPPT.Presentations.Open(Trim(strCopyFile))
objPPT.Activate()
Catch Ex As Exception
' This is a fatal error
MsgBox("Error - There was a problem opening " & strCopyFile & ". Error message: " & Ex.Message)
GoTo ExitError
End Try
NumberOfSlides = objPres.Slides.Count
ReverseCounter = NumberOfSlides
If NumberOfSlides <= 1 Then
' This is a fatal error
MsgBox("Error - Only presentations that contain multiple slides can be split")
GoTo ExitError
End If
objPres.Slides(1).Select()
For i = 1 To objPres.Slides(1).Shapes.Count
If objPres.Slides(1).Shapes(i).HasTextFrame Then
SlideName = objPres.Slides(1).Shapes(i).TextFrame.TextRange.Text
Exit For
End If
Next i
objPres.Close()
' Create new show based on the number of slides in slideset ###############################
For ShowCounter = 1 To NumberOfSlides
strSuccess = False
intCounter = 1
If Len(SlideName) > 0 Then
' Reduce long names down to 30 characters #########################################
If Len(SlideName) > 30 Then
SlideName = Strings.Left(SlideName, 30)
End If
' Remove illegal filename characters ##############################################
SlideName = Replace(SlideName, "?", "")
SlideName = Replace(SlideName, "/", "-")
SlideName = Replace(SlideName, "\", "-")
SlideName = Replace(SlideName, "‘", "")
SlideName = Replace(SlideName, "'", "")
SlideName = Replace(SlideName, "*", "x")
SlideName = Replace(SlideName, "%", "")
SlideName = Replace(SlideName, ":", ".")
SlideName = Replace(SlideName, "|", "")
SlideName = Replace(SlideName, "<", "")
SlideName = Replace(SlideName, ">", "")
SlideName = Replace(SlideName, """", "")
' Crop a string after a carraige return (illegal) #################################
If InStr(SlideName, ControlChars.Cr) > 0 Then
SlideName = Strings.Left(SlideName, InStr(SlideName, ControlChars.Cr) - 1)
End If
Else
' Otherwise, string is zero characters ############################################
SlideName = "Slide title not found"
End If
' Make a copy of the file and open it for editing #####################################
strNewFileName = strWorkingFolder & "\" & ShowCounter & "." & SlideName & "." & strExtension
While intCounter < intAttempts And strSuccess = False
If System.IO.File.Exists(strNewFileName) Then
intCounter = intCounter + 1
strNewFileName = strWorkingFolder & "\" & ShowCounter & "." & SlideName & "(" & intCounter & ")." & strExtension
Else
File.Copy(Trim(strCopyFile), strNewFileName)
objPres = objPPT.Presentations.Open(strNewFileName)
strSuccess = True
End If
End While
' Find the name of the next slide #################################################
If (ShowCounter + 1) <= NumberOfSlides Then
objPres.Slides(ShowCounter).Select()
For i = 1 To objPres.Slides(ShowCounter + 1).Shapes.Count
If objPres.Slides(ShowCounter + 1).Shapes(i).HasTextFrame Then
SlideName = objPres.Slides(ShowCounter + 1).Shapes(i).TextFrame.TextRange.Text
If Len(SlideName) > 0 Then
Exit For
End If
End If
Next i
Else
SlideName = "Title not found"
End If
' Open the slideshow to work with #################################################
With objPPT.ActivePresentation
' Remove each slide from last to first ########################################
Do Until ReverseCounter = 0
objSlide = objPres.Slides(ReverseCounter)
If ReverseCounter <> ShowCounter Then
objPres.Slides(ReverseCounter).Delete()
End If
ReverseCounter = ReverseCounter - 1
Loop
' Save and close this slideshow ###################################################
Try
' Save the temporary file #####################################################
objPres.Save()
' Close PowerPoint ############################################################
objPres.Close()
' Initialize the MFilesClientApplication object ###############################
Dim oClientApp As New MFilesAPI.MFilesClientApplication
' Log into a vault through a document vault connection "CITI" #################
Dim oVaultConnection As MFilesAPI.VaultConnection = oClientApp.GetVaultConnection("CITI")
Dim m_vault As MFilesAPI.Vault = oVaultConnection.BindToVault(Me.Handle, True, False)
' Create property definitions #################################################
Dim oPropertyValues As MFilesAPI.PropertyValues = New MFilesAPI.PropertyValues
' Add 'Name and Title' property by creating a new PropertyValue object.
' The PropertyValue object encapsulates the metadata information (PropertyDef)
' and the actual value (TypedValue).
Dim oPropertyValue1 As MFilesAPI.PropertyValue = New MFilesAPI.PropertyValue
oPropertyValue1.PropertyDef = MFilesAPI.MFBuiltInPropertyDef.MFBuiltInPropertyDefNameOrTitle
oPropertyValue1.TypedValue.SetValue(MFilesAPI.MFDataType.MFDatatypeText, SlideName)
oPropertyValues.Add(0, oPropertyValue1)
' Add 'Class' property
Dim oPropertyValue2 As MFilesAPI.PropertyValue = New MFilesAPI.PropertyValue
oPropertyValue2.PropertyDef = MFilesAPI.MFBuiltInPropertyDef.MFBuiltInPropertyDefClass
oPropertyValue2.TypedValue.SetValue(MFilesAPI.MFDataType.MFDatatypeLookup, _
MFilesAPI.MFBuiltInDocumentClass.MFBuiltInDocumentClassUnclassifiedDocument)
oPropertyValues.Add(1, oPropertyValue2)
' Add 'Single file' property
Dim oPropertyValue3 As MFilesAPI.PropertyValue = New MFilesAPI.PropertyValue
oPropertyValue3.PropertyDef = MFilesAPI.MFBuiltInPropertyDef.MFBuiltInPropertyDefSingleFileObject
oPropertyValue3.TypedValue.SetValue(MFilesAPI.MFDataType.MFDatatypeBoolean, True)
oPropertyValues.Add(2, oPropertyValue3)
' Add source file.
Dim oSourceFiles As MFilesAPI.SourceObjectFiles = New MFilesAPI.SourceObjectFiles
Dim oSourceFile1 As MFilesAPI.SourceObjectFile = New MFilesAPI.SourceObjectFile
oSourceFile1.SourceFilePath = strNewFileName
oSourceFile1.Title = SlideName
oSourceFile1.Extension = strExtension
oSourceFiles.Add(0, oSourceFile1)
' Create new object.
Dim oObjectVersionAndProperties As MFilesAPI.ObjectVersionAndProperties
oObjectVersionAndProperties = m_vault.ObjectOperations.CreateNewObject( _
MFilesAPI.MFBuiltInObjectType.MFBuiltInObjectTypeDocument, _
oPropertyValues, oSourceFiles)
' Check in the newly created object.
m_vault.ObjectOperations.CheckIn(oObjectVersionAndProperties.ObjVer)
' Delete the original file (until I find a method to save directly into M-Files)
File.Delete(strNewFileName)
Catch Ex As Exception
MessageBox.Show("Save to M-Files error. Original error: " & Ex.Message)
End Try
End With
ReverseCounter = NumberOfSlides
Next ShowCounter
Try
objPres.Close()
objPres = Nothing
Catch
End Try
Try
objPPT.Quit()
objPPT = Nothing
Catch
End Try
System.GC.Collect()
If Len(ErrorMessage) > 0 Then
MsgBox("Error - Problems were encountered, unable to export slide number " & ErrorMessage)
End If
End If
Me.Show()
ExitError:
Try
objPres.Close()
objPres = Nothing
Catch ex As Exception
End Try
Try
objPPT.Quit()
objPPT = Nothing
Catch ex As Exception
End Try
System.GC.Collect()
End Sub
Thanks in advance for any advice.
Paul
