求助，这段代码怎么增加excel文件具体sheet表地址的？？？，sheet1，sheet2等

chenshi0513

' 此程序批处理同一个文件夹中的所有xls文件

Function IsCScript()
        If (InStr(UCase(WScript.FullName), "CSCRIPT") <> 0)        Then
                IsCScript =        True
        Else
                IsCScript =        False
        End        If
End        Function
'------------------------------------------------------------
' 强制在CScript下运行。如果在WScript下运行，退出，强制用Script重新解释运行
Sub        ForceInCScript()
        Dim        WshShell
        Set        WshShell = WScript.CreateObject("WScript.Shell")
       
        If (Not        IsCScript()) Then
           If WScript.Arguments.Count = 0 Then
                        WshShell.Run "CScript.exe "        & """" & WScript.ScriptFullName        & """"
                Else
                        WshShell.Run "CScript.exe "        & """" & WScript.ScriptFullName        & """ " & WScript.Arguments.Item(0)
                End If
                WScript.Quit ' Terminate script.
        End        If
End        Sub

' 强制在CScript下执行
' 如果需要编译成exe，必须注释掉这句。
ForceInCScript

WScript.Echo "批处理Excel文件程序"
WScript.Echo "------------------------------------------"
WScript.Echo "arcqiufeng@163.com              2017-04-10"
WScript.Echo "------------------------------------------"

' 定义常用计数变量
Dim        i,j,k,c

Dim        fso, f,        ff,        file, ScriptFolder
Set        fso        = CreateObject("Scripting.FileSystemObject")
Set        f =        fso.GetFile(WScript.ScriptFullName)
ScriptFolder = fso.getParentFolderName(f)

' ---------------创建ket或Excel－－－－－－－－－
Dim        Excel
' 忽略错误
On Error Resume        Next
' 尝试创建Excel程序       
Set        Excel =        CreateObject("Excel.Application")
If Excel Is        Nothing        Then '        创建Excel失败。可能Excel没有安装
        Set        Excel =        CreateObject("KET.Application") '尝试创建ET
        If Excel Is        Nothing        Then '        两者都失败，退出
                MsgBox "KET或Excel未安装，需首先安装KET或Excel。", vbInformation,        "注意"
                WScript.Quit
        End        If
End        If
' 恢复错误处理
On Error Goto 0

' 创建统计表
Dim        workbook, worksheet
Set        workbook = Excel.WorkBooks.add

Excel.Visible =        True

Set wb = Excel.workbooks.open(ScriptFolder & "\修改数据.xls")
Dim d
Set d = CreateObject("scripting.dictionary")
i =2
Do While Trim(wb.activesheet.cells(i,1).Value)<>""
        wscript.echo wb.activesheet.cells(i,1) & "->" & wb.activesheet.cells(i,2)
        d(wb.activesheet.cells(i,1).Value & ".xls")=wbactivesheet.cells(i,2).Value
        i=i+1
Loop
wb.close

For        Each datafile In d.keys
        Set        wb = Excel.workbooks.open(ScriptFolder & "\" & datafile)
        fn = GetFilenameWithoutExtension(fso.GetFile(datafile).Name)
        WScript.echo "读取 " & fn & "..."

        wb.activesheet.range("G2") = d(datafile)

        wb.save
        wb.close
Next


' --------- 程序结束

Function AddBackslash(ThisFolderPath)
        If Not Right(ThisFolderPath,1) = "\" Then
                ThisFolderPath = ThisFolderPath & "\"
        End If
        AddBackslash = ThisFolderPath
End Function

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 = "请选择数据文件所在的文件夹:"
    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


Function GetFilenameWithoutExtension(ByVal FileName)
  Dim Result, i
  Result = FileName
  i = InStrRev(FileName, ".")
  If ( i > 0 ) Then
    Result = Mid(FileName, 1, i - 1)
  End If
  GetFilenameWithoutExtension = Result
End Function
       
MsgBox "完成。", vbInformation