如何解决如何使用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 举报,一经查实,本站将立刻删除。