返回列表 上一主題 發帖

[設一個巨集] 開啟檔案 問題....

jakcy1234

帖子
37 
主題
10 
精華
0 
積分
63 
點名
0  
作業系統
XP 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2013-8-25 
最後登錄
2016-5-24 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-8-31 00:05 | 只看該作者

[設一個巨集] 開啟檔案 問題....

file
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

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2013-9-1 13:41 | 只看該作者
回復 1# jakcy1234
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim fs As Object, File_Nane As String
  4.     Set fs = CreateObject("Scripting.FileSystemObject")
  5.     File_Nane = Dir("C:\*.xls")   '搜尋資料夾裡的副檔名
  6.     Do While File_Nane <> ""
  7.         Set fs = CreateObject("Scripting.FileSystemObject").GetFILE(File_Nane)
  8.         If UBound(Split(File_Nane, "_")) > 0 Then                              '檔案名稱中有 "???_???_"
  9.             If Val(Split(File_Nane, "_")(1)) >= 6 And fs.Size / 1024 > 100 Then
  10.                 Workbooks.Open (fs)
  11.             End If
  12.         End If
  13.         File_Nane = Dir         '搜尋資料夾裡下一個相同的副檔名

  15.     Loop
  16. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jakcy1234

帖子
37 
主題
10 
精華
0 
積分
63 
點名
0  
作業系統
XP 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2013-8-25 
最後登錄
2016-5-24 
3#
發表於 2013-9-1 17:21 | 只看該作者
回復 2# GBKEE
  1. Set sht1 = Sheets("Sheet1")
  2. Set sht2 = Sheets("Sheet2")
  3. lastrow = sht1.Cells(sht1.Rows.Count, 1).End(xlUp).Row
  4. For rw = 2 To lastrow
  5. With sht2.QueryTables.Add(Connection:= _
  6. "URL;" & sht1.Cells(rw, 1).Value _
  7. , Destination:=Sheets("Sheet2").Range("A1"))
  8. .Name = Sheet
  9. .FieldNames = False
  10. .RowNumbers = False
  11. .FillAdjacentFormulas = False
  12. .PreserveFormatting = False
  13. .RefreshOnFileOpen = False
  14. .BackgroundQuery = False
  15. .RefreshStyle = xlInsertDeleteCells
  16. .SavePassword = False
  17. .SaveData = False
  18. .AdjustColumnWidth = False
  19. .RefreshPeriod = 0
  20. .WebSelectionType = xlEntirePage
  21. .WebFormatting = xlWebFormattingNone
  22. .WebPreFormattedTextToColumns = False
  23. .WebConsecutiveDelimitersAsOne = False
  24. .WebSingleBlockTextImport = False
  25. .WebDisableDateRecognition = False
  26. .Refresh BackgroundQuery:=False
  27. End With
複製代碼
因為我是用web query aspx 來開檔 但不知道要點改

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2013-9-1 20:43 | 只看該作者
回復 3# jakcy1234
因為我是用web query aspx 來開檔 -> 1#的哪些檔名是存在一個資料庫中,你依據為開檔的資料嗎?(哪些檔案存在你的PC,給你的程式碼,可用嗎!)
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jakcy1234

帖子
37 
主題
10 
精華
0 
積分
63 
點名
0  
作業系統
XP 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2013-8-25 
最後登錄
2016-5-24 
5#
發表於 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 以下的檔案 (在電腦自動刪除 或者 不會讀取就可以).

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 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\*.*")   '搜尋資料夾裡所有檔案

  1. Option Explicit
  2. Sub Ex()
  3.     Dim fs As Object, File_Nane As String
  4.     Set fs = CreateObject("Scripting.FileSystemObject")
  5.     File_Nane = Dir("C:\*.xls")   '搜尋資料夾裡的副檔名
  6.     Do While File_Nane <> ""
  7.         Set fs = CreateObject("Scripting.FileSystemObject").GetFILE(File_Nane)
  8.         If UBound(Split(File_Nane, "_")) > 0 Then                              '檔案名稱中有 "???_???_"
  9.             If Val(Split(File_Nane, "_")(1)) >= 6 And fs.Size / 1024 > 70 Then '00006 以後的 size 超過 70kb的檔案
  10.                 Workbooks.Open (fs)
  11.             Else
  12.                 Kill fs      '在電腦自動刪除 ' 或不讀取->註解這程式碼不執行
  13.             End If
  14.         Else
  15.             Kill fs         '在電腦自動刪除 ''檔案名稱中沒有 "????????_?????"
  16.                              '或不讀取 -> 註解這程式碼不執行        
  17.         End If
  18.         File_Nane = Dir         '搜尋資料夾裡下一個相同的副檔名
  19.     Loop
  20. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 忘功不忘過，忘怨不忘恩。
返回列表 上一主題