|
代码运行不通过,麻烦高手修正。谢谢
Sub 批量将VISIO文件转成PDF()
Dim str As String, n As Long, Nam As String
Set VisioApp = GetObject(, "Visio.Application")
On Error GoTo err '程序出错时则退出
' Dim fd As Object
' Set fd = Application.FileDialog(msoFileDialogFolderPicker)
Dim Filename$, myPath$, dPath$ '文件名,路径
Dim thesh As Object
Dim thefolder As Object
Set thesh = CreateObject("shell.application")
Set thefolder = thesh.BrowseForFolder(0, "", 0, "")
myPath = thefolder.Items.Item.Path
myPath = myPath & Application.PathSeparator
Dim Fp As String
Fp = myPath & "PDF" '新建文件夹全路径名
If Dir(Fp, vbDirectory) = "" Then
MkDir Fp
Else
End If
dPath = myPath & Application.PathSeparator & Fp
Application.DisplayAlerts = False
Application.ScreenUpdating = False '关闭屏幕更新,提升速度
str = Dir(myPath & "\*.VSD*") '开始查找文件,格式为所有vsd和vsdx文件
While Len(str) > 0
n = n + 1 '累加变量,该变量代表文件数量
MsgBox (myPath & str)
MsgBox (dPath)
VisioApp.Documents.Open myPath & str
VisioApp.ActiveDocument.ExportAsFixedFormat visFixedFormatPDF, myPath & str, 1, 0
VisioApp.ActiveDocument.Close
str = Dir() '查找下一个
Wend
Application.ScreenUpdating = True '恢复屏幕更新
err:
End Sub
|
|