|
樓主 |
發表於 2017/7/24 02:25:58
|
顯示全部樓層
分享一下代碼…
- Sub ExcelTools()
- Dim vaArray As Variant
- Dim objFSO As Object
- Dim objFolder As Object
- Dim objFile As Object
- Dim i As Integer
- Set objFSO = CreateObject("Scripting.FileSystemObject")
- Set objFolder = objFSO.GetFolder("") '雙引號內填入工具所在資料夾名稱,注意最後不要有""
- ReDim vaArray(1 To objFolder.Files.Count)
- i = 1
- Tools = "Please select a EXCEL file. ( 0 = Exit )" & Chr(10)
- For Each objFile In objFolder.Files
- vaArray(i) = objFile.Name
- If Right(objFile, 4) = "xlsm" Or Right(objFile, 4) = "xlsx" Or Right(objFile, 4) = ".xls" Then
- ToolName = Right(objFile, Len(objFile) - Len(objFolder) - 1)
- Tools = Tools & Chr(10) & i & " " & ToolName
- i = i + 1
- End If
- Next objFile
- i = i - 1
- Start:
- X = InputBox(Tools, objFolder)
- If X > i Then
- MsgBox "Invalid Value!Please Try again."
- GoTo Start
- ElseIf X = 0 Then
- Exit Sub
- Else
- Dim xlApp As Object
- Set xlApp = CreateObject("Excel.Application")
- xlApp.Application.Visible = True
- xlApp.Workbooks.Open (objFolder & "" & vaArray(X))
- End If
- End Sub
複製代碼
|
|