返回列表 上一主題 發帖

[發問] 請問如何更改VB的連結檔案路徑

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 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

  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
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 受人點水之恩，須當湧泉以報。
返回列表 上一主題