VBS大神请教问题：VBS通过文件浏览框选择单个文件而不是文件夹？

黑夜中前行 2018-09-28 04:13:11
VBS大神们你们好，

本人VBS小白，有一个问题一直弄不明白，在VBS中有没有类似于shell的BrowseForFolder的命令可以选择单个文件？
我需要做一个PPT合并工具，将三个ppt按照顺序合并到一个ppt中，代码ok了，但是有两个问题：
因为不知道怎么获取单个PPT obj对象，我用的是遍历for each的方法，很简陋，导致我的代码在文件夹选择框中只能选择文件夹，而且文件夹内只能放一个ppt，否则会出错。
合并PPT后原来的PPT样式（三个ppt本来就是一个ppt拆开的，所以模板一致，我现在要根据111，222，333...的规则逐张合并）不能保留，导致ppt变形，能不能做一下改进？代码如下，保存为.vbs直接运行可看效果。希望大神们不吝赐教，必有重谢~~~

备注：如果VBS不能实现以上功能的话VB可以吗？欢迎大家讨论



Option Explicit

Dim pptApp 

Dim NewPres,MyPres1,MyPres2,MyPres3 '创建对象，用于存放PPT

Dim Fso,oFile1,oFile2,oFile3

Dim MyPath1,MyPath2,MyPath3,SavedPath

Dim i



Set pptApp = CreateObject("PowerPoint.Application")'创建并返回对PPT Automation对象的引用

Set Fso = CreateObject("Scripting.FileSystemObject") 



MyPath1 = BrowseForFolder & "\" '对话框中选定的当前文件夹路径

'这里尝试采用不遍历的方法获得所选文件，失败了~~~~遍历方法可以，但是只能在文件夹下只有一个ppt的时候使用

'使用GetOpenFilename可以实现获取单个PPT的目的吗？？

'set oFile1= Fso.GetFolder(MyPath1).Files

'Set MyPres1 = GetObject(MyPath1  & oFile1.Name)

For Each oFile1 In Fso.GetFolder(MyPath1).Files

    If InStr(oFile1.Name, ".ppt") >0 And InStr(oFile1.Name, "~$")=0 Then 

	Set MyPres1 = GetObject(MyPath1 & oFile1.Name)

	End if

next

MyPath2 = BrowseForFolder & "\" 

'set oFile2= Fso.GetFolder(MyPath2).Files

'Set MyPres2 = GetObject(MyPath2  & oFile2.Name)

For Each oFile2 In Fso.GetFolder(MyPath2).Files

    If InStr(oFile2.Name, ".ppt") >0 And InStr(oFile2.Name, "~$")=0 Then 

    Set MyPres2 = GetObject(MyPath2 & oFile2.Name)

	End if



next

MyPath3 = BrowseForFolder & "\"

'set oFile3= Fso.GetFolder(MyPath3).Files

'set MyPres3 = GetObject(MyPath3 & oFile3.Name)

For Each oFile3 In Fso.GetFolder(MyPath3).Files

    If InStr(oFile3.Name, ".ppt") >0 And InStr(oFile3.Name, "~$")=0 Then 

    Set MyPres3 = GetObject(MyPath3 & oFile3.Name)

	End if

next

SavedPath = BrowseForFolderD & "\" '对话框中选定的当前文件夹路径，能否改成选定单个ppt？？？？？



'以下代码通过复制粘贴实现PPT三合一，但是不能保留原始PPT风格模板，方法比较笨，大神如有更好的方法欢迎分享



Set NewPres = pptApp.Presentations.Add(0) '创建新演示文稿，新演示文稿不显示

        If MyPres1.Slides.Count=MyPres2.Slides.Count and MyPres2.Slides.Count=MyPres3.Slides.Count then

	        For i = 1 To MyPres1.Slides.Count

                MyPres1.Slides(i).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

			

			    MyPres2.Slides(i).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

			

			    MyPres3.Slides(i).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

			Next

                NewPres.SaveAs(SavedPath & "Merged PPT")

                NewPres.Close

                Set NewPres = Nothing

				

		else if MyPres1.Slides.Count=MyPres2.Slides.Count and MyPres2.Slides.Count>MyPres3.Slides.Count then

	        

			For i = 1 To MyPres1.Slides.Count-1

                MyPres1.Slides(i).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

			 

			    MyPres2.Slides(i).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

			

			    MyPres3.Slides(i).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

	        Next

			    MyPres1.Slides(MyPres1.Slides.Count).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

			    MyPres2.Slides(MyPres1.Slides.Count).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

                NewPres.SaveAs(SavedPath & "Merged PPT")

                NewPres.Close

                Set NewPres = Nothing

				

		else 

		    For i = 1 To MyPres1.Slides.Count-1

                MyPres1.Slides(i).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

			 

			    MyPres2.Slides(i).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

			

			    MyPres3.Slides(i).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)

            Next

			    MyPres1.Slides(MyPres1.Slides.Count).Copy

                NewPres.Slides.Paste (NewPres.Slides.Count + 1)		

                NewPres.SaveAs(SavedPath & "Merged PPT")

                NewPres.Close

                Set NewPres = Nothing

        End if  



Set Fso = Nothing

Set pptApp = Nothing



MsgBox "结束" '以下能否将shell BrowseForFolder这个打开文件夹的命令改成打开文件的命令？

'___________________________________________________________________________________

Function BrowseForFolder()  '定义对话框格式



Dim FD

Set FD = CreateObject("Shell.Application").BrowseForFolder(0, "请以左-中-右屏顺序选择PPT所在文件夹：", 0, 0) '定义对话框格式

If Not FD Is Nothing Then'如果选择文件夹则返回文件夹路径

    BrowseForFolder = FD.Self.Path & ""

Else

    MsgBox "已取消"

	wscript.quit

    Exit Function

End if



End Function

'___________________________________________________________________________________

Function BrowseForFolderD()  '定义对话框格式



Dim FDD

Set FDD = CreateObject("Shell.Application").BrowseForFolder(0, "请选择存放合并PPT的文件夹：", 0, 0) '定义对话框格式

If Not FDD Is Nothing Then'如果选择文件夹则返回文件夹路径

    BrowseForFolderD = FDD.Self.Path & ""

	MsgBox "开始合并", vbOKOnly+vbInformation

Else

    MsgBox "已取消"

	wscript.quit

    Exit Function

End if



End Function

End if
...全文
430 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
黑夜中前行 2018-10-08
  • 打赏
  • 举报
 回复
引用 6 楼 Chen8013 的回复:
[quote=引用 4 楼 weixin_42281254 的回复:]
[quote=引用 1 楼 Chen8013 的回复:]
查了一下，Shell.Application对象有选择文件夹的接口，却没有“选择文件”的接口。


其实可以用你的 pptApp 文件选择接口来选择文件的，不过“用户体验”有点差：
1.　必须先把 pptApp显示出来，才能“看到”文件选择对话框；
2.　选择文件后，“活动任务”变成刚才这个“PPT进程”了，不能回到VBS上。

不过，对你的这个“应用”来说，这“2.”似乎不是问题。


谢谢指点，作为小白没看懂，浪费了大神心意。不过题目中第二个问题，如何保留模板大神有什么好的思路吗？我在考虑先三个ppt首尾相连然后排序，但是排序操作VBS貌似做不到[/quote]

我几乎是没使用过ppt，可以说是仅限于“看看而已”。
更何况MS 的ppt，它的VBA功能，与Excel相比，简直就是个“残废”。
我也没明白你这儿说的“排序”究竟是排什么序…………


你在3Ｌ说，要“布置到网上”，如果VBS脚本写在“网页”中，你可以直接利用网页的“文件选择”表单对象啊。
我在上面说的VBS中通过你创建的app对象来打开文件，参考代码如下：
Option Explicit

Dim pptApp, FileName



Set pptApp = CreateObject("PowerPoint.Application")

FileName = SelectFile(pptApp)

If(len(FileName))then

   MsgBox "选择的文件是："&FileName, 64

Else

   MsgBox "没有选择文件。",64

End If

pptApp.Quit

set pptApp = Nothing

Wscript.Quit



Function SelectFile(objApp)

   Dim objDialog

   Set objDialog = objApp.FileDialog(3)

   objDialog.AllowMultiSelect=False     ' 单文件选择

   objDialog.Filters.Clear

   objDialog.Filters.Add "MS ppt文件(*.ppt, *.pptx)", "*.ppt;*.pptx"

   objDialog.Filters.Add "所有文件(*.*)", "*.*"

   objApp.Visible = True     '必须显示出来才可以

   If (objDialog.Show()) Then

      SelectFile=objDialog.SelectedItems(1)

   Else

      SelectFile=""

   End If

   set objDialog=Nothing

End Function

这段代码，你可以先直接写到一个单独的VBS文件中试一下效果。
如果要用的话，能“理解代码”之后，就可以移植到你自己的VBS中，按你的需求进行修改。
[/quote]

谢谢大神的代码，后来直接跳过了这部分，用python实现了上线
无·法 2018-09-29
  • 打赏
  • 举报
 回复
引用 3 楼 weixin_42281254 的回复:
[quote=引用 2 楼 sysdzw 的回复:]
用什么vbs，好好的vb不用


VB没有用过，这个应用之后要布置到网上，VBS更适合一点吧。大神如果有思路能否不吝赐教，谢谢[/quote]几乎一样的，拉进去一个按钮，双击按钮，然后把你的代码复制到里面。直接就能运行了！
黑夜中前行 2018-09-29
  • 打赏
  • 举报
 回复
引用 1 楼 Chen8013 的回复:
查了一下，Shell.Application对象有选择文件夹的接口，却没有“选择文件”的接口。


其实可以用你的 pptApp 文件选择接口来选择文件的，不过“用户体验”有点差：
1.　必须先把 pptApp显示出来，才能“看到”文件选择对话框；
2.　选择文件后，“活动任务”变成刚才这个“PPT进程”了，不能回到VBS上。

不过，对你的这个“应用”来说，这“2.”似乎不是问题。


谢谢指点，作为小白没看懂，浪费了大神心意。不过题目中第二个问题，如何保留模板大神有什么好的思路吗？我在考虑先三个ppt首尾相连然后排序，但是排序操作VBS貌似做不到
黑夜中前行 2018-09-29
  • 打赏
  • 举报
 回复
引用 2 楼 sysdzw 的回复:
用什么vbs，好好的vb不用


VB没有用过，这个应用之后要布置到网上，VBS更适合一点吧。大神如果有思路能否不吝赐教，谢谢
舉杯邀明月 2018-09-29
  • 打赏
  • 举报
 回复
引用 4 楼 weixin_42281254 的回复:
[quote=引用 1 楼 Chen8013 的回复:]
查了一下，Shell.Application对象有选择文件夹的接口，却没有“选择文件”的接口。


其实可以用你的 pptApp 文件选择接口来选择文件的，不过“用户体验”有点差：
1.　必须先把 pptApp显示出来，才能“看到”文件选择对话框；
2.　选择文件后，“活动任务”变成刚才这个“PPT进程”了，不能回到VBS上。

不过，对你的这个“应用”来说，这“2.”似乎不是问题。


谢谢指点，作为小白没看懂，浪费了大神心意。不过题目中第二个问题，如何保留模板大神有什么好的思路吗？我在考虑先三个ppt首尾相连然后排序，但是排序操作VBS貌似做不到[/quote]

我几乎是没使用过ppt，可以说是仅限于“看看而已”。
更何况MS 的ppt，它的VBA功能，与Excel相比，简直就是个“残废”。
我也没明白你这儿说的“排序”究竟是排什么序…………


你在3Ｌ说，要“布置到网上”，如果VBS脚本写在“网页”中，你可以直接利用网页的“文件选择”表单对象啊。
我在上面说的VBS中通过你创建的app对象来打开文件，参考代码如下：
Option Explicit

Dim pptApp, FileName



Set pptApp = CreateObject("PowerPoint.Application")

FileName = SelectFile(pptApp)

If(len(FileName))then

   MsgBox "选择的文件是："&FileName, 64

Else

   MsgBox "没有选择文件。",64

End If

pptApp.Quit

set pptApp = Nothing

Wscript.Quit



Function SelectFile(objApp)

   Dim objDialog

   Set objDialog = objApp.FileDialog(3)

   objDialog.AllowMultiSelect=False     ' 单文件选择

   objDialog.Filters.Clear

   objDialog.Filters.Add "MS ppt文件(*.ppt, *.pptx)", "*.ppt;*.pptx"

   objDialog.Filters.Add "所有文件(*.*)", "*.*"

   objApp.Visible = True     '必须显示出来才可以

   If (objDialog.Show()) Then

      SelectFile=objDialog.SelectedItems(1)

   Else

      SelectFile=""

   End If

   set objDialog=Nothing

End Function

这段代码，你可以先直接写到一个单独的VBS文件中试一下效果。
如果要用的话，能“理解代码”之后，就可以移植到你自己的VBS中，按你的需求进行修改。
无·法 2018-09-28
  • 打赏
  • 举报
 回复
用什么vbs，好好的vb不用
舉杯邀明月 2018-09-28
  • 打赏
  • 举报
 回复
查了一下，Shell.Application对象有选择文件夹的接口，却没有“选择文件”的接口。


其实可以用你的 pptApp 文件选择接口来选择文件的，不过“用户体验”有点差：
1.　必须先把 pptApp显示出来，才能“看到”文件选择对话框；
2.　选择文件后，“活动任务”变成刚才这个“PPT进程”了，不能回到VBS上。

不过，对你的这个“应用”来说，这“2.”似乎不是问题。
VBScript脚本语言编程与自动化运维操作学习篇
1、课程概要        本课程主要分享VBScript脚本语言编程与自动化运维操作学习教程！2、课程目标        本课程致力于帮助学员学习并掌握VBScript脚本语言编程及自动化运维技巧！3、适合人员        本课程适合兴趣VBS编程或从事运维自动化的学员观看学习！4、特别说明       本课程支持一次购买，永久观看，请大家放心选购！
Winform单个exe实现自更新的技巧
经常从CSDN学习技巧或下载资源，感谢这个平台，也感谢各位大神。最近迁移自己以前代码时发现一些技巧，决定分享出来。首次写博客，有不对的地方请大家多理解。 Winform实现软件升级的方法很多，比如采用ClickOnce发布、Update.exe + 主程序.exe。而本文讲的是只有一个exe的情况下巧用vbs脚本执行命令实现自杀并更新的方式，网上关于这种方式的资料较少...
pyqt5单个exe实现自更新的技巧
但我们pyqt5经常就是打成单个exe可执行文件，又不想另外加个Update.exe程序，怎么办？ 问题转化一下，就是：pyqt5的单个exe可执行文件，如何实现自更新呢？
c#文件操作代码段保存
C# 文件操作大全 1.创建文件夹 //using System.IO; Directory.CreateDirectory(%%1); 2.创建文件 //using System.IO; File.Create(%%1); 3.删除文件 //using System.IO; File.Delete(%%1); 4.删除文件夹 //using System.IO; Directory.De...
C# 文件操作类大全
1、创建文件夹 //using System.IO; Directory.CreateDirectory(%%1); 2、创建文件 //using System.IO; File.Create(%%1); 3、删除文件夹//usingSystem.IO;Directory.Delete(%%1); 4.删除文件 //using Sy...
VBA

2,462

社区成员

10,807

社区内容

发帖
与我相关
我的任务
社区描述
VBA（Visual Basic for Applications）是Visual Basic的一种宏语言，是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。
社区管理员
  • VBA
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章