標題: [發問] 請問如何更改VB的連結檔案路徑 [打印本頁]

---

作者: v60i    時間: 2011-12-27 06:34     標題: 請問如何更改VB的連結檔案路徑

這個VBA功能是將多個TXT內容全部會集到同一個EXCEL中
但是這程式必須跟TXT在同一個目錄
我試著修改成把程式放在C:\指定匯集D:\中的TXT
可是都沒成功
請問要怎麼修改才OK??
謝謝


Sub 匯入文字檔()
Dim xFile, uFile, uHead As Range, Jm&, Km&, X, xT, xL
Range("A:A").Clear '清除舊匯入資料
'-----------------------------------------------------
Application.ScreenUpdating = False
Do
    If xChk = 0 Then
       xFile = Dir(ThisWorkbook.Path & "\*.txt")
       If xFile = "" Then MsgBox "※找不到 TXT 檔案！　", 0 + 16: Exit Sub
       xChk = 1
    Else
       xFile = Dir
       If xFile = "" Then Exit Do
    End If
    '----------------------------------------------
    uFile = ThisWorkbook.Path & "\" & xFile
    Set uHead = Range("A65536").End(xlUp)
    If uHead <> "" Then Set uHead = uHead(3, 1)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & uFile, Destination:=uHead)
         .AdjustColumnWidth = False
         .TextFileColumnDataTypes = Array(1)
         .Refresh BackgroundQuery:=False
         .Delete
    End With
    uHead.Interior.ColorIndex = 6
    '每筆第一格加〔黃色〕底
NEXT_LINE:
Loop
'-------------------------------------------------------
Application.ScreenUpdating = True
MsgBox "∼∼匯入完成∼∼　"
End Sub


[attach]8932[/attach]

---

作者: Hsieh    時間: 2011-12-27 08:43

回復 1# v60i
用資料夾對話方塊結果取代ThisWorkbook.Path

1. Sub 匯入文字檔()
   
2. Dim xFile, uFile, uHead As Range, Jm&, Km&, X, xT, xL
   
3. Range("A:A").Clear '清除舊匯入資料
   
4. '-----------------------------------------------------
   
5. With Application.FileDialog(msoFileDialogFolderPicker)
   
6. .Show
   
7. fd = .SelectedItems(1)
   
8. End With
   
9. 
   
10. Application.ScreenUpdating = False
    
11. Do
    
12.     If xChk = 0 Then
    
13.        xFile = Dir(fd & "\*.txt")
    
14.        If xFile = "" Then MsgBox "※找不到 TXT 檔案！　", 0 + 16: Exit Sub
    
15.        xChk = 1
    
16.     Else
    
17.        xFile = Dir
    
18.        If xFile = "" Then Exit Do
    
19.     End If
    
20.     '----------------------------------------------
    
21.     uFile = fd & "\" & xFile
    
22.     Set uHead = Range("A65536").End(xlUp)
    
23.     If uHead <> "" Then Set uHead = uHead(3, 1)
    
24.     With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & uFile, Destination:=uHead)
    
25.          .AdjustColumnWidth = False
    
26.          .TextFileColumnDataTypes = Array(1)
    
27.          .Refresh BackgroundQuery:=False
    
28.          .Delete
    
29.     End With
    
30.     uHead.Interior.ColorIndex = 6
    
31.     '每筆第一格加〔黃色〕底
    
32. NEXT_LINE:
    
33. Loop
    
34. '-------------------------------------------------------
    
35. Application.ScreenUpdating = True
    
36. MsgBox "∼∼匯入完成∼∼　"
    
37. End Sub

複製代碼

---

作者: v60i    時間: 2012-1-3 06:31

回復 2# Hsieh


    大大 如果我點出了選擇資料夾畫面後 如果按取消 會出現
[attach]9001[/attach]
點選偵錯
fd = .SelectedItems(1)
會反黃耶

---

作者: GBKEE    時間: 2012-1-3 07:59

回復 3# v60i

1. With Application.FileDialog(msoFileDialogFolderPicker)
   
2. If .Show = 0 Then Exit Sub   '改這裡
   
3. fd = .SelectedItems(1)
   
4. End With

複製代碼

---

作者: v60i    時間: 2012-1-12 06:42

回復 4# GBKEE


    謝謝大大的修正

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)