個人積分：0分
文章編號：89064852
請問我要怎麼改才可以一次全部下載裡面資料夾的檔案
因為資料夾裡面的當案隨時會增減
檔案資料夾連結
https://drive.google.com/drive/folders/19gf7B5C8TjJfLVqddJvmmzA1qD0mec6V
Sub cc()
Dim Alpath As String
Dim myFolder As FileDialog
Set fs = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False '停止更新閃爍
Application.DisplayAlerts = False '直接覆蓋檔案不再跳出視窗
Alpath = Range("b18")
If fs.FileExists(Range("b18") & "\" & "每日更新.rar") Then
With Workbooks.Open("https://storage.googleapis.com/drive-bulk-export-anonymous/20240127T102610.895Z/4133399871716478688/5ae070bd-da21-4969-a061-e2ef72ed6936/1/e2932d67-2653-48b2-8a27-60834c88b83b?authuser")
.SaveAs Filename:=Alpath & "每日更新", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
.Close
Application.DisplayAlerts = True '直接覆蓋檔案不再跳出視窗
End With
Else
MsgBox "請選擇檔案下載後的存檔位置"
Set myFolder = Application.FileDialog(msoFileDialogFolderPicker)
myFolder.InitialFileName = ThisWorkbook.Path
myFolder.Show
Range("b18") = myFolder.SelectedItems.Item(1) & "\"
End If
End Sub
個人積分：0分
文章編號：89068237
snare wrote:
或是改用200樓範例，直接下載csv檔，再開啟
Snare大師您好：
我嘗試用1390樓的範例下載上市收盤價CSV檔，速度超快的。但是除了A欄要改成文字格式外，我不知道如何處理B欄證券名稱變成空白欄的問題，敬請提示，謝謝。程式碼如下：
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long '這個專案的程式碼需修改才能用於64位元系統。請檢視和更新Declare陳述式，然後以PtrSafe屬性加以標記
#End If
Sub GetTwseCsv()
Dim Url, Target, TwseT86csv, Clipboard As Object, TwseT86 As Object, daytext As String
Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set TwseT86 = CreateObject("scripting.filesystemobject")
On Error GoTo checkid
Target = "c:\excel\" '暫存目錄
If Dir(Target, vbDirectory) = "" Then MkDir Target
'注意，暫存目錄下的檔案，會在無任何提示下刪除
If Dir(Target & "*.*") <> "" Then Kill Target & "*.*"
Sheets("最新上市收盤價").Cells.Clear
Application.ScreenUpdating = False
Application.DisplayAlerts = False
daytext = InputBox("日期(7碼數字)", , Format(Date, "yyyymmdd") - 19110000) + 19110000
'daytext = "20240126"
Url = "https://www.twse.com.tw/rwd/zh/afterTrading/MI_INDEX?date=" & daytext & "&type=ALLBUT0999&response=csv"
ttt = Timer
URLDownloadToFile 0, Url, Target & "ALLBUT0999_" & daytext & ".csv", 0, 0
'如果單純只是要下載檔案，程式碼到這裡鳩可以結束了。
With TwseT86.OpenTextFile(Target & "ALLBUT0999_" & daytext & ".csv", 1)
TwseT86csv = Replace(.ReadAll, "=", "")
.Close
End With
If Len(TwseT86csv) = 2 Then
Sheets("最新上市收盤價").Cells(1, 1) = "很抱歉，沒有符合條件的資料!"
Exit Sub
End If
With Clipboard
.SetText TwseT86csv
.PutInClipboard
End With
'選取最新上市收盤價工作表
Sheets("最新上市收盤價").Select
Cells.Clear
With Sheets("最新上市收盤價")
.Cells(1, 1).Select
.PasteSpecial NoHTMLFormatting:=True
.Columns("A:A").TextToColumns DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True
.Columns.ColumnWidth = 10
.Columns("B:B").ColumnWidth = 17
.Columns("A:A").HorizontalAlignment = xlLeft
.Rows(2).WrapText = True
.Range("A1:E1").MergeCells = True
.Cells(1, 1).Select ' 刪除這行
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox .Cells(1, 1) & vbNewLine & "資料筆數" & .Range("a1").CurrentRegion.Rows.Count - 9 & "筆" & vbNewLine & "使用時間" & Round(Timer - ttt, 2) & "秒", vbOKOnly, "下載完成"
End With
Set Clipboard = Nothing
Set TwseT86 = Nothing
checkid:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
End Sub
也許是原始csv的問題，資料日期?也可能是那堆排版程式碼的問題，那個範例都快7年了，把跟排版有關的全刪掉，開全新檔案重做一個，看看會不會消失。
大師 您好：排版部分，修改後就OK了。謝謝您。
個人積分：3127分
文章編號：89087650
個人積分：0分
文章編號：89101020
Morten Hsu wrote:
Morten Hsu wrote:
2、改版很久了，是網址錯了。https://www.twse.com.tw/rwd/zh/fund/T86?date=20240123&selectType=ALL&response=csv
謝謝Snare大師，已經可以正確下載了。
大師 您好：
我是把下列處理排版的語法取消：
.Columns("A:A").TextToColumns DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Comma:=True
.Rows(2).WrapText = True
.Range("A1:E1").MergeCells = True
因為執行 .Columns("A:A").TextToColumns 就會發生B欄空白，取消它就會有正常的顯示結果。但是取消 .Columns("A:A").TextToColumns 有時也會下載逗點分割的CSV檔，不過再重新執行一次，又可以下載Excel儲存格式的檔案。不知道是甚麼原因，敬請解惑。謝謝！
個人積分：3127分
文章編號：89101243
Morten Hsu wrote:
就會發生B欄空白
如果是同一個檔案，時好時壞
不要用200樓的CreateObject("scripting.filesystemobject")方式匯入
快7年前twse下載的csv檔，常常會在資料內混入等號"="，會造成匯入資料不正確
所以當時有在程式碼中處理等號
如果是不同檔案
需看原始csv檔，才能確定問題
改用open for ... input ，一格一格匯入csv，試看看
Sub csvtest()
Dim R As Integer, C As Integer, F As Integer, FileName As String, data As String
F = FreeFile
'路徑+檔案名稱
FileName = "d:\excel\csvtest.csv"
Excel.Application.ScreenUpdating = False
With Sheets("工作表1")
.Cells.Clear
Open FileName For Input As F
R = 1
Do Until EOF(F)
Line Input #F, data
temp = Split(data, ",")
For C = 0 To UBound(temp)
.Cells(R, C + 1) = temp(C)
Next C
R = R + 1
Loop
Close F
End With
Excel.Application.ScreenUpdating = True
End Sub
大師 您好：Line Input #F, data 會把上市收盤價的千分號當逗號而予以分割。
請看1408樓
個人積分：3127分
文章編號：89104121
Morten Hsu wrote:
Line Input #F, data 會把上市收盤價的千分號當逗號而予以分割。...(恕刪)
放假太無聊，修正一下排版、資料剖析誤判逗號、空白的問題
試了數10個日期，沒看到B欄消失了
注意，原工作表內資料，要先刪除重建，或是重開新檔。
[點擊下載]
個人積分：11分
文章編號：89145672
目前下載yahoo金融資料的價格資料,
不過不論怎麼修改起始日期,
下載的資料卻始終停在101列的日期
,
也試著要去確認下載的資訊 不過卻摸不值頭緒怎麼看下載的資料(table下有太多巢狀格,能請教要去哪邊確認下載的資訊嗎?)
謝謝~
[點擊下載]
個人積分：3127分
文章編號：89146342
