Board logo

標題: 如何每次開啟選擇匯入文字檔之路徑 [打印本頁]
作者: sping    時間: 2017-7-23 09:26     標題: 如何每次開啟選擇匯入文字檔之路徑

以下的程式是用錄製巨集的功能完成的
主要是要將文字檔匯入excel指定欄位
可是因為有時候文字檔路徑不一樣
致程式無法順利執行
不知道要怎樣改成可以跳出視窗選擇檔案路徑，才可以不用每次重錄巨集
希望有人能協助，謝謝
  1. Sub Macro1()
  2. '
  3. ' Macro1 Macro
  4. ' 匯入檔案
  5. '

  7. '
  8.     With ActiveSheet.QueryTables.Add(Connection:= _
  9.         "TEXT;C:\Users\USER\Desktop\新會\99.txt", Destination:=Range("$A$2"))
  10.         .Name = "99"
  11.         .FieldNames = True
  12.         .RowNumbers = False
  13.         .FillAdjacentFormulas = False
  14.         .PreserveFormatting = True
  15.         .RefreshOnFileOpen = False
  16.         .RefreshStyle = xlInsertDeleteCells
  17.         .SavePassword = False
  18.         .SaveData = True
  19.         .AdjustColumnWidth = True
  20.         .RefreshPeriod = 0
  21.         .TextFilePromptOnRefresh = False
  22.         .TextFilePlatform = 950
  23.         .TextFileStartRow = 1
  24.         .TextFileParseType = xlFixedWidth
  25.         .TextFileTextQualifier = xlTextQualifierDoubleQuote
  26.         .TextFileConsecutiveDelimiter = False
  27.         .TextFileTabDelimiter = True
  28.         .TextFileSemicolonDelimiter = False
  29.         .TextFileCommaDelimiter = False
  30.         .TextFileSpaceDelimiter = False
  31.         .TextFileColumnDataTypes = Array(9, 1, 9, 9)
  32.         .TextFileFixedColumnWidths = Array(38, 32, 28)
  33.         .TextFileTrailingMinusNumbers = True
  34.         .Refresh BackgroundQuery:=False
  35.     End With
  36.     ActiveWindow.SmallScroll Down:=-27
  37. End Sub
複製代碼
作者: Kubi    時間: 2017-7-25 10:02

回復 1# sping
試試看
  1. Sub Macro1()
  2. '
  3. ' Macro1 Macro
  4. ' 匯入檔案
  5. '

  7. '
  8.    txtFile = Application.GetOpenFilename("文字檔, *.txt")
  9.    txtFile = "TEXT;" & txtFile
  10.     With ActiveSheet.QueryTables.Add(Connection:=txtFile, Destination:=Range("$A$2"))
  11.         .FieldNames = True
  12.         .RowNumbers = False
  13.         .FillAdjacentFormulas = False
  14.         .PreserveFormatting = True
  15.         .RefreshOnFileOpen = False
  16.         .RefreshStyle = xlInsertDeleteCells
  17.         .SavePassword = False
  18.         .SaveData = True
  19.         .AdjustColumnWidth = True
  20.         .RefreshPeriod = 0
  21.         .TextFilePromptOnRefresh = False
  22.         .TextFilePlatform = 950
  23.         .TextFileStartRow = 1
  24.         .TextFileParseType = xlFixedWidth
  25.         .TextFileTextQualifier = xlTextQualifierDoubleQuote
  26.         .TextFileConsecutiveDelimiter = False
  27.         .TextFileTabDelimiter = True
  28.         .TextFileSemicolonDelimiter = False
  29.         .TextFileCommaDelimiter = False
  30.         .TextFileSpaceDelimiter = False
  31.         .TextFileColumnDataTypes = Array(9, 1, 9, 9)
  32.         .TextFileFixedColumnWidths = Array(38, 32, 28)
  33.         .TextFileTrailingMinusNumbers = True
  34.         .Refresh BackgroundQuery:=False
  35.     End With
  36.     ActiveWindow.SmallScroll Down:=-27
  37. End Sub
複製代碼
作者: PKKO    時間: 2017-7-25 10:48

回復 1# sping

'選檔案   
Set FD = Excel.Application.FileDialog(msoFileDialogFilePicker)  '設定選取檔案功能
FD.Filters.Clear    '清除之前的資料
'FD..InitialFileName = "c:temp\"'默認路徑
FD.Filters.Add "Excel File", "*.xls*" '設定顯示的副檔名
If FD.Show = -1 Then
     Path = FD.SelectedItems(1)
Else
    End
End If
Workbooks.Open Path
作者: sping    時間: 2017-7-26 23:22

回復 2# Kubi


非常謝謝
可以用了
作者: sping    時間: 2017-7-26 23:24

回復 3# PKKO


感謝你
順利解決工作上的問題



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