power point saveas method using vba

Hi,




I want to open each powerpoint file from one folder and saveas into another folder with same file name by using VBA. Pls help me.




regards
syed

Do you really want to open and save or could you not just copy the files to a second folder (either manually or with code)

I want to saveas ppt file to mp4 video. ( from one folder to another folder)

HI,

There are some powerpoint file along with excel files in a folder. I want to convert all those ppt files (which are modified today) into mp4 by using save as method. i wrote a code for this. but few lines of code is not working properly (code colored with blue) pls go through the below code and help me.

Option Explicit


Sub GetFolderPath()
Dim InputFolder As String
Dim OutputFolder As String
Dim fd1, fd2 As FileDialog
Dim cpath, dpath As String
Dim FileInFromFolder As Object
Dim fil As Scripting.File
Dim cfolder, dfolder As Scripting.Folder
'-----------------------------------------------------------------------------------------
Dim fso As Scripting.filesystemobject
Dim actionclicked As Boolean
Set fso = New Scripting.filesystemobject
Set fd1 = Application.FileDialog(msoFileDialogFolderPicker)
Set fd2 = Application.FileDialog(msoFileDialogFolderPicker)


fd1.Title = "pick the folder to save files into"
fd1.AllowMultiSelect = False
actionclicked = fd1.Show
If actionclicked Then
InputFolder = fd1.SelectedItems(1)
Else
MsgBox "You didn't pick a folder"
Exit Sub
End If
If InputFolder = "" Then
MsgBox "Select a folder then click Yes"
Exit Sub
End If
cpath = InputFolder


Set fso = New Scripting.filesystemobject


Set cfolder = fso.GetFolder(cpath)
cpath = Replace(cpath, "\\", "\")
Debug.Print cfolder




Set fd2 = Application.FileDialog(msoFileDialogFolderPicker)
fd2.Title = "pick the folder to save files into"
fd2.AllowMultiSelect = False
actionclicked = fd2.Show
If actionclicked Then
OutputFolder = fd2.SelectedItems(1)
Else
MsgBox "You didn't pick a folder"
Exit Sub
End If
If OutputFolder = "" Then
MsgBox "Select a folder then click Yes"
Exit Sub
End If
dpath = OutputFolder




Set fso = New Scripting.filesystemobject


Set dfolder = fso.GetFolder(dpath)
dpath = Replace(dpath, "\\", "\")




'Debug.Print dfolder
For Each fil In cfolder.Files


If Left(fso.GetExtensionName(fil.Path), 2) = "pp" And Format(fil.DateLastModified, "dd/mm/yyyy") = Format(Date, "dd/mm/yyyy") Then
Application.ActivePresentation.SaveAs _
FileName:=dpath & "\" & fil.Name & ".mp4", _
FileFormat:=ppSaveAsMP4

End If

Next
End Sub


Thank you in advance.


regards
syed

Cross-posted at: http://www.msofficeforums.com/powerp...p4-videos.html
Please read VBAExpress' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3

I note also you have started two threads here on this topic. That too breaches the rules. I've merged them.

Quote:

---

Originally Posted by macropod

Cross-posted at: http://www.msofficeforums.com/powerp...p4-videos.html
Please read VBAExpress' policy on Cross-Posting in item 3 of the rules: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3

I note also you have started two threads here on this topic. That too breaches the rules. I've merged them.

---

Iam sorry. As i did not get the solution, so i asked same question again. Will you pls help me in solving ppt query.

Thank you in advance.

The basic reason you didn't get the response you're after is that you didn't provide enough relevant information for anyone to help. Your first post implied you wanted nothing more than a copy of some files, for which no VBA is required. If you don't provide the proper information, you can't expect the right solution. You might even consider letting people know which version of PowerPoint you're using. That's important, since PowerPoint 2010 has no such thing as a ppSaveAsMP4 FileFormat option - that wasn't introduced till PowerPoint 2013. Thus, only people with PowerPoint 2013 or later can use that format. Finally, saying only that "few lines of code is not working properly" is not enough - you need to say what particular problem you're having and what 'working properly" in that context would mean.

|More info would be useful as MacroPod says

You might try this though

If fso.GetExtensionName(fil.Path) Like "pp*" And DateDiff("d", fil.DateLastModified, Date) < 1 Then

Frankly, I wouldn't even bother with the FileSystemObject - I'd simply use a folder picker, then use the Dir function to retrieve only .ppt* files. Avoids a lot of the circumlocution the current code is doing. For example:

Code:

---

Sub ConvertPresentations()
Dim strSrcFldr As String, strTgtFldr As String, strFlNm As String, ppPrs As Presentation
    strTgtFldr = GetFolder("Choose an OUPUT folder")
    If strTgtFldr = "" Then Exit Sub
    strSrcFldr = GetFolder("Choose an INPUT folder")
    If strSrcFldr = "" Then Exit Sub
    strFlNm = Dir(strSrcFolder & "\*.ppt", vbNormal)
    While strFlNm <> ""
        Set ppPrs = Presentations.Open(FileName:=strSrcFldr & "\" & strFlNm, ReadOnly:=True)
        With ppPrs
          .SaveAs FileName = strTgtFldr & "\" & Split(strFlNm, ".ppt")(0) & ".mp4", FileFormat:=ppSaveAsMP4
          .Close
        End With
        strFlNm = Dir()
    Wend
    Set ppPrs = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder(strMsg As String) As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, strMsg, 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function

---