Board logo

標題: [發問] 請教如何將選擇檔案(原本只能選一個，想改成一次選多個) [打印本頁]
作者: leoman0002    時間: 2013-5-16 20:54     標題: 請教如何將選擇檔案(原本只能選一個，想改成一次選多個)

原先是使用
fd = ThisWorkbook.Path & "\"
fs = Dir(fd & "*.csv")

但是常常有需要臨時匯入的情況，後來修改之後...變成一次只能匯入一個檔案，
想情教各位老師!! 我應該要修改哪裡 ^^  



[attach]14995[/attach]
  1. Sub ex()
  2.    Dim arr()
  3.   Dim Filename As Variant
  4.   Dim i As Integer
  5.   fs = Application.GetOpenFilename("僅能匯入csv格式,*.csv", , "確定", , False)
  6.   p = Range("G65536").End(xlUp).Row + 1
  7.   With CreateObject("Microsoft.XMLHTTP")
  8.   .Open "GET", fs, False
  9.   .Send
  10.   tt = .responsetext
  11.   ss = Split(tt, vbCrLf)
  12.   End With
  13.   ReDim arr(0 To UBound(ss), 0 To 15)
  14.   For i = 0 To UBound(ss)
  15.   s1 = Split(ss(i), ",")
  16.   For j = 0 To UBound(s1)
  17.     arr(i, j) = s1(j)
  18.   Next j
  19.   Next i
  20.   Cells(p, "a") = Replace(arr(5, 1), "'", "")
  21.   Cells(p, "b") = Replace(Split(Cells(p, "a"), "-")(0), Mid(Split(Cells(p, "a"), "-")(0), 3, 5), "")
  22.   Cells(p, "c") = Split(Cells(p, "a"), "-")(1)
  23.   Cells(p, "G") = arr(3, 3)
  24.   If arr(11, 7) = "Bef" Then
  25.   Cells(p, "H") = "[Before]"
  26.   Else
  27.   Cells(p, "H") = "[After]"
  28.   End If
  29.   Cells(p, "I") = arr(11, 5)
  30.   Cells(p, "J") = arr(11, 5)
  31.   Cells(p, "K") = arr(20, 5)
  32.   Cells(p, "R") = arr(21, 5)
  33.   Cells(p, "S") = arr(22, 5)
  34.   Cells(p, "T") = arr(23, 5)
  35.   k = 20
  36.   For i = 26 To 33
  37.   For j = 1 To 3
  38.     k = k + 1
  39.     Cells(p, k) = arr(i, (j - 1) * 2 + 1)
  40.   Next j
  41.   Next i
  42. End Sub
複製代碼
作者: Hsieh    時間: 2013-5-16 22:17

回復 1# leoman0002
  1. Sub ex()
  2.    Dim arr()
  3.   Dim Filename As Variant
  4.   Dim i As Integer
  5.   fs = Application.GetOpenFilename("僅能匯入csv格式,*.csv", , "③確定", , True)  '改成複選檔案
  6.   For Each f In fs '每個檔案迴圈
  7.   p = Range("G65536").End(xlUp).Row + 1
  8.   With CreateObject("Microsoft.XMLHTTP")
  9.   .Open "GET", f, False
  10.   .Send
  11.   tt = .responsetext
  12.   ss = Split(tt, vbCrLf)
  13.   End With
  14.   ReDim arr(0 To UBound(ss), 0 To 15)
  15.   For i = 0 To UBound(ss)
  16.   s1 = Split(ss(i), ",")
  17.   For j = 0 To UBound(s1)
  18.     arr(i, j) = s1(j)
  19.   Next j
  20.   Next i
  21.   Cells(p, "a") = Replace(arr(5, 1), "'", "")
  22.   Cells(p, "b") = Replace(Split(Cells(p, "a"), "-")(0), Mid(Split(Cells(p, "a"), "-")(0), 3, 5), "")
  23.   Cells(p, "c") = Split(Cells(p, "a"), "-")(1)
  24.   Cells(p, "G") = arr(3, 3)
  25.   If arr(11, 7) = "Bef" Then
  26.   Cells(p, "H") = "[Before]"
  27.   Else
  28.   Cells(p, "H") = "[After]"
  29.   End If
  30.   Cells(p, "I") = arr(11, 5)
  31.   Cells(p, "J") = arr(11, 5)
  32.   Cells(p, "K") = arr(20, 5)
  33.   Cells(p, "R") = arr(21, 5)
  34.   Cells(p, "S") = arr(22, 5)
  35.   Cells(p, "T") = arr(23, 5)
  36.   k = 20
  37.   For i = 26 To 33
  38.   For j = 1 To 3
  39.     k = k + 1
  40.     Cells(p, k) = arr(i, (j - 1) * 2 + 1)
  41.   Next j
  42.   Next i
  43.   Next f
  44. End Sub
複製代碼
作者: leoman0002    時間: 2013-5-17 00:08

這就是我想要的結果，學習到了....感謝



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