如何将两个脚本合二为一?

时间:2015-04-30 19:21:25

标签: excel vbscript

在stackoverflow成员的帮助下,我有以下工作脚本。

' 26Apr2015 jkw -- q&d

Option Explicit

Dim g_fso:  Set g_fso = CreateObject("Scripting.FileSystemObject")

Dim tgt: tgt = BrowseFolder("M:\MarcStone Bids", False)
' If no folder selected, quit 
If tgt="" Then 
    Wscript.Quit 1
End If

Dim subdirs:  subdirs = Array(_
"Anchors",_
"Color",_
"Engineering",_
"Mold Drawings",_
"Plans and Specs",_
"Plans and Specs\Plans",_
"Plans and Specs\Specs",_
"Shops",_
"Managing Documents",_
"Managing Documents\Accounting",_
"Managing Documents\Approvals",_
"Managing Documents\Bid Documents",_
"Managing Documents\Revisions and Cost Changes",_
"Transmittals"_
)

Dim subdir
For Each subdir in subdirs
    g_fso.CreateFolder(tgt & "\" & subdir)
Next

Function BrowseFolder( myStartLocation, blnSimpleDialog )
' This function generates a Browse Folder dialog
' and returns the selected folder as a string.
'
' Arguments:
' myStartLocation   [string]  start folder for dialog, or "My Computer", or
'                             empty string to open in "Desktop\My Documents"
' blnSimpleDialog   [boolean] if False, an additional text field will be
'                             displayed where the folder can be selected
'                             by typing the fully qualified path
'
' Returns:          [string]  the fully qualified path to the selected folder
'
' Based on the Hey Scripting Guys article
' "How Can I Show Users a Dialog Box That Only Lets Them Select Folders?"
' http://www.microsoft.com/technet/scriptcenter/resources/qanda/jun05/hey0617.mspx
'
' Function written by Rob van der Woude
' http://www.robvanderwoude.com
    Const MY_COMPUTER   = &H11&
    Const WINDOW_HANDLE = 0 ' Must ALWAYS be 0

    Dim numOptions, objFolder, objFolderItem
    Dim objPath, objShell, strPath, strPrompt

    ' Set the options for the dialog window
    strPrompt = "Select a folder in which to create subdirectories:"
    If blnSimpleDialog = True Then
        numOptions = 0      ' Simple dialog
    Else
        numOptions = &H10&  ' Additional text field to type folder path
    End If

    ' Create a Windows Shell object
    Set objShell = CreateObject( "Shell.Application" )

    ' If specified, convert "My Computer" to a valid
    ' path for the Windows Shell's BrowseFolder method
    If UCase( myStartLocation ) = "MY COMPUTER" Then
        Set objFolder = objShell.Namespace( MY_COMPUTER )
        Set objFolderItem = objFolder.Self
        strPath = objFolderItem.Path
    Else
        strPath = myStartLocation
    End If

    Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _
                                              numOptions, strPath )

    ' Quit if no folder was selected
    If objFolder Is Nothing Then
        BrowseFolder = ""
        Exit Function
    End If

    ' Retrieve the path of the selected folder
    Set objFolderItem = objFolder.Self
    objPath = objFolderItem.Path

    ' Return the path of the selected folder
    BrowseFolder = objPath
End Function

通过浏览stackoverflow和谷歌搜索,我设法将该脚本转换为以下内容,将excel文档复制到用户选择的文件夹中。

Option Explicit

Dim filesys:  Set filesys = CreateObject("Scripting.FileSystemObject")

Dim tgt: tgt = BrowseFolder("M:\Plant", False)
If tgt="" Then 
    Wscript.Quit 1
End If

If filesys.FileExists("E:\Datastore\MarcStone Bids\5000\New temp 4-28-15.xlsx") Then
filesys.CopyFile "E:\Datastore\MarcStone Bids\5000\New temp 4-28-15.xlsx", (tgt & "\")
End If

Function BrowseFolder( myStartLocation, blnSimpleDialog )
    Const MY_COMPUTER   = &H11&
    Const WINDOW_HANDLE = 0

    Dim numOptions, objFolder, objFolderItem
    Dim objPath, objShell, strPath, strPrompt

    strPrompt = "Select a folder in which to create subdirectories:"
    If blnSimpleDialog = True Then
        numOptions = 0
    Else
        numOptions = &H10&
    End If

    Set objShell = CreateObject( "Shell.Application" )

    If UCase( myStartLocation ) = "MY COMPUTER" Then
        Set objFolder = objShell.Namespace( MY_COMPUTER )
        Set objFolderItem = objFolder.Self
        strPath = objFolderItem.Path
    Else
        strPath = myStartLocation
    End If

    Set objFolder = objShell.BrowseForFolder( WINDOW_HANDLE, strPrompt, _
                                              numOptions, strPath )

    If objFolder Is Nothing Then
        BrowseFolder = ""
        Exit Function
    End If

    Set objFolderItem = objFolder.Self
    objPath = objFolderItem.Path

    BrowseFolder = objPath
End Function

我想把两者结合起来,这样当"管理文件\投标文件"创建文件夹后,excel文件将被复制到该位置。

我只需要合并两个操作的方向。

P.S。学习这些东西真是太有趣了:〜)提前感谢您的帮助!

0 个答案:

没有答案