麻辣家族討論版版 - Powered by Discuz! Board

標題: [設一個巨集] 開啟檔案問題.... [打印本頁]

作者: jakcy1234 時間: 2013-8-31 00:05 標題: [設一個巨集] 開啟檔案問題....

C:\auto_download_page\chap42589_00001_2013_0830_1457" =====> file size 70kb
C:\auto_download_page\chap42589_00002_2013_0830_1458" =====> file size 70kb
C:\auto_download_page\chap42589_00003_2013_0830_1459" =====> file size 70kb
C:\auto_download_page\chap42589_00004_2013_0830_1500" =====> file size 70kb
C:\auto_download_page\chap42589_00005_2013_0830_1501" =====> file size 70kb
C:\auto_download_page\chap42589_00006_2013_0830_1502" =====> file size 230kb
C:\auto_download_page\chap42589_00007_2013_0830_1503" =====> file size 230kb
C:\auto_download_page\chap42589_00008_2013_0830_1504" =====> file size 230kb

請問如果我要設一個巨集定時開啟檔案
如果 file size 是100kb 以下就不開啟 ( 循環 N 次 ) ( 並有次序 file名 00001 , 00002 .............. 測試開啟檔案 )
直到檔案 00006 的 size 超過 100kb 才開啟檔案, macro 應該怎寫 ???

作者: GBKEE 時間: 2013-9-1 13:41

回復 1# jakcy1234
試試看

Option Explicit
Sub Ex()
Dim fs As Object, File_Nane As String
Set fs = CreateObject("Scripting.FileSystemObject")
File_Nane = Dir("C:\*.xls") '搜尋資料夾裡的副檔名
Do While File_Nane <> ""
Set fs = CreateObject("Scripting.FileSystemObject").GetFILE(File_Nane)
If UBound(Split(File_Nane, "_")) > 0 Then '檔案名稱中有 "???_???_"
If Val(Split(File_Nane, "_")(1)) >= 6 And fs.Size / 1024 > 100 Then
Workbooks.Open (fs)
End If
End If
File_Nane = Dir '搜尋資料夾裡下一個相同的副檔名
Loop
End Sub

複製代碼

作者: jakcy1234 時間: 2013-9-1 17:21

回復 2# GBKEE

Set sht1 = Sheets("Sheet1")
Set sht2 = Sheets("Sheet2")
lastrow = sht1.Cells(sht1.Rows.Count, 1).End(xlUp).Row
For rw = 2 To lastrow
With sht2.QueryTables.Add(Connection:= _
"URL;" & sht1.Cells(rw, 1).Value _
, Destination:=Sheets("Sheet2").Range("A1"))
.Name = Sheet
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With

複製代碼

因為我是用web query aspx 來開檔但不知道要點改

作者: GBKEE 時間: 2013-9-1 20:43

回復 3# jakcy1234
因為我是用web query aspx 來開檔 -> 1#的哪些檔名是存在一個資料庫中,你依據為開檔的資料嗎?(哪些檔案存在你的PC,給你的程式碼,可用嗎!)

作者: jakcy1234 時間: 2013-9-1 22:12

回復 4# GBKEE

對, 那些檔案是從下載軟件 download 到電腦 ,
因為經網上 webquerytable取data太慢,
我現在用 cmd.exe >dir /b > filelist.txt paste 在sheet1 A欄裡,
再用A欄裡的path link 順序去取file data  ( 100個file既data 不用2分鐘就RUN完 )
==================================================
我正在探索中你程式碼 "error 53 file not find "
CreateObject("Scripting.FileSystemObject").GetFile(File_Name)
If UBound(Split(File_Nane, "_")) > 0 Then
還有_ 的意思是否要指定這樣 000000000_00000_0000_0000_0000
因為有4個 _ _ _ _          chap42589_00001_2013_0830_1457
                                 chap42590_00001_2013_0830_1458

現在只差有沒有另類方法可以將 70kb 以下的檔案 (在電腦自動刪除或者不會讀取就可以).

作者: GBKEE 時間: 2013-9-2 07:09

回復 5# jakcy1234
那些檔案是從下載軟件 download 到電腦 , 下載到C:\嗎?
不是要修改 ->  File_Nane = Dir("C:\auto_download_page\*.xls") '搜尋資料夾裡的副檔名
這 C:\auto_download_page\chap42589_00001_2013_0830_1457  的副檔名是xls ??
不是或所有檔案 ->  File_Nane = Dir("C:\auto_download_page\*.*") '搜尋資料夾裡所有檔案

Option Explicit
Sub Ex()
Dim fs As Object, File_Nane As String
Set fs = CreateObject("Scripting.FileSystemObject")
File_Nane = Dir("C:\*.xls") '搜尋資料夾裡的副檔名
Do While File_Nane <> ""
Set fs = CreateObject("Scripting.FileSystemObject").GetFILE(File_Nane)
If UBound(Split(File_Nane, "_")) > 0 Then '檔案名稱中有 "???_???_"
If Val(Split(File_Nane, "_")(1)) >= 6 And fs.Size / 1024 > 70 Then '00006 以後的 size 超過 70kb的檔案
Workbooks.Open (fs)
Else
Kill fs '在電腦自動刪除 ' 或不讀取->註解這程式碼不執行
End If
Else
Kill fs '在電腦自動刪除 ''檔案名稱中沒有 "????????_?????"
'或不讀取 -> 註解這程式碼不執行
End If
File_Nane = Dir '搜尋資料夾裡下一個相同的副檔名
Loop
End Sub

複製代碼

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