GBKEE

回復 13# yangjie

1. Option Explicit
   
2. Sub 選擇檔名匯入()
   
3.     Dim Path1, Str1 As String
   
4.     Dim wb As Workbook
   
5.     Dim Filt As String
   
6.     Dim FilterIndex As Integer
   
7.     Dim Title As String
   
8.     '---------------------------------
   
9.     Dim xlfileName As String, xlFullName As String
   
10.     '修改型態 As String  xlfileName:沒有路徑
    
11.     Dim MyPath
    
12.     MyPath = CurDir    '紀錄原有的目錄或檔案夾。
    
13.     Path1 = Application.ActiveWorkbook.Path
    
14.    ' Path1 = "C:\WINDOWS\SYSTEM"
    
15.     ChDrive Split(Path1, ":")(0)    'ChDrive 陳述式 改變目前的磁碟機。
    
16.     ChDir Path1                     'ChDir   陳述式 改變目前的目錄或檔案夾。
    
17.     '請注意 ChDir 陳述式會改變現有目錄位置，但不會改變磁碟機位置，
    
18.     '例如，如果現在的磁碟機是 C，陳述式將現有目錄切換到磁碟機 D，但是 C 仍然是現有的磁碟機位置：
    
19.     Filt = "Excel Files (*.xls),*.xls"
    
20.     FilterIndex = 5
    
21.     Title = "Select a File for Import"
    
22.     xlFullName = Application.GetOpenFilename _
    
23.         (FileFilter:=Filt, _
    
24.          FilterIndex:=FilterIndex, _
    
25.          Title:=Title)
    
26.    
    
27.     If UCase(xlFullName) = "FALSE" Then
    
28.         MsgBox "No file was selected."
    
29.         Exit Sub
    
30.     End If
    
31.     '''''''''''''''''''''''''
    
32.     ChDrive Split(MyPath, ":")(0)    '改變為原有的磁碟機。
    
33.     ChDir MyPath                     '改變為原有的目錄或檔案夾。
    
34.     ''''''''''''''''''''''''''
    
35.    
    
36.     xlfileName = Split(xlFullName, "\")(UBound(Split(xlFullName, "\")))
    
37.     '陣列(上限元素數) 取的檔案名稱沒有路徑
    
38.     If IsOpen(xlfileName) <> False Then
    
39.         Workbooks(xlfileName).Activate
    
40.     Else
    
41.         Set wb = Workbooks.Open(xlFullName, True, False)
    
42.     End If
    
43.     f_bookname2 = ActiveWorkbook.Name
    
44.     Windows(f_bookname2).Activate
    
45.     Sheets(1).Activate
    
46. End Sub
    
47. Function IsOpen(Fs As String) As Boolean
    
48.     IsOpen = False
    
49.     For Each W In Windows
    
50.          If W.Caption = Fs Then IsOpen = True: Exit For
    
51.    Next
    
52. End Function

複製代碼

GBKEE

回復 15# Hsieh
那有什麼湊熱鬧的,論壇是越熱鬧越好