如何使用VBA在powerpoint中创建新文件夹？

问题描述

我正在尝试使用此宏将我的 powerpoint 幻灯片以 pdf 格式保存在新文件夹中，该文件夹不是事先创建的。问题是 MkDir 似乎没有创建根文件夹，而是文件夹内的文件夹。因此，如果我想在 C:\ 中创建全新的文件夹，它不会这样做，“运行时错误 '76' 路径未找到”发生。

Sub Creating_Folder()

Dim timestamp As Date
Dim PR As PrintRanges
Dim lngLast As Long
Dim lngFirst As Long
Dim savePath As String
Dim PrintPDF As Integer
Dim name As String
Dim originalHides() As Long
Dim slidesToPrint() As Variant
Dim i As Variant
Dim folderPath As String
Dim strPath As String
Dim folder As String

strPath = "C:\Powerpoint2\test_file\"

If Not FolderExists(strPath) Then
    FolderCreate strPath
End If

'Create a folder if it does not already exist,if it does,do nothing
'folderPath = "\\?\C:\Powerpoint\new_folder2"

'Check if the folder exists
'If Dir(folderPath,vbDirectory) = "" Then

    'Folder does not exist,so create it
   ' MkDir folderPath

'End If

timestamp = Now()

With ActivePresentation
    name = .Slides(2).Shapes("TextBox1").OLEFormat.Object.Text
    savePath = strPath & Format(timestamp,"yyyymmdd-hhnn") & " - " & name & ".pdf"
    lngLast = .Slides.Count
    .PrintOptions.Ranges.Clearall
    
    slidesToPrint = Array(2,lngLast)
    
    ReDim originalHides(1 To lngLast)
    For i = 1 To lngLast
      originalHides(i) = .Slides(i).SlideShowTransition.Hidden
      .Slides(i).SlideShowTransition.Hidden = -1
    Next
    For Each i In slidesToPrint()
      .Slides(i).SlideShowTransition.Hidden = 0
    Next
    .ExportAsFixedFormat _
        Path:=savePath,_
        FixedFormatType:=ppFixedFormatTypePDF,_
        Intent:=ppFixedFormatIntentScreen,_
        FrameSlides:=msoTrue
    For i = 1 To lngLast
      .Slides(i).SlideShowTransition.Hidden = originalHides(i)
    Next
End With
End Sub

也将这个添加到结尾

Function FolderCreate(ByVal path As String) As Boolean

FolderCreate = True
Dim fso As New FileSystemObject

If fso.FolderExists(path) Then
    Exit Function
Else
    On Error GoTo DeadInTheWater
    fso.CreateFolder path ' Could there be any error with this,like if the path is really screwed up?
    Exit Function
End If

DeadInTheWater:
    MsgBox "A folder Could not be created for the following path: " & path & ". Check the path name and try again."
    FolderCreate = False
    Exit Function

End Function

Function FolderExists(ByVal path As String) As Boolean

FolderExists = False
Dim fso As New FileSystemObject

If fso.FolderExists(path) Then FolderExists = True

End Function

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

create-directory directory directory pdf powerpoint