none
[VB6] 如何抓取某資料夾內的所有檔案名稱 RRS feed

  • 問題

  • 請問一下各位先進

    我現在要將某資料夾內的所有檔案進行壓縮

    ex 資料夾中有三個檔案 1.txt   ,  2.txt  , 3.doc

    我要如何透過VB6的程式 去分別把這三個檔案壓縮成 1.rar  ,2.rar  ,3.rar

    小弟 只會用 Shell 指令去執行rar進行整個資料夾的壓縮 然後放到目的地位子

    ex    Shell "rar a d:\moni\Updaterar d:\Update"

           將Update的資料夾壓縮後放置 moni資夾裡


    我目前的想法 為     是不是可以透過 迴圈方式  然後 抓取 資料夾內的檔案名稱 去做壓縮的處理

    以上  還請大家給予指導  謝謝
    2009年10月7日 上午 10:48

解答

所有回覆

  • 可以。
    請使用 VB6 內建的 Dir 函數。使用方式詳見線上說明。
    論壇是網友平等互助 保證解答請至 微軟技術支援服務
    • 已標示為解答 烏龍茶 2009年10月7日 下午 01:03
    2009年10月7日 上午 11:35
  • 恩 謝謝 我會用了
    2009年10月7日 下午 01:04
  • 小弟又要上來請教了

    程式碼如下所示

    目的是想要在進行檔案壓縮完後   就 將原始檔刪除

    但是 我加入 KILL Source後 就不會產生壓縮檔

    我又加了一個 msgbox 去檢查 Source 後

    卻又正常了

    msgbox 不是只有丟回訊息而已嗎???

    1.請問一下 如何修改 讓我 不加msgbox 也可以達到 原始檔案壓縮完畢後 立即刪除

    2.或是有其他的方法  可以直接刪除某資料夾內的所有檔案呢

    謝謝



    Dim Filenames As String Filenames = Dir("d:\moni\CKL\") Do While Filenames <> "" File = Mid(Filenames, 1, 3) Source = "d:\moni\CKL\" + Filenames Target = "d:\moni\單位正式下傳目錄\分會檔\" + File + ".rar" Shell "rar a " + Target + " " + Source + "" Filenames = Dir '再次呼叫dir函数,此時可以不帶參數 MsgBox Source '不加此行 無法產生壓縮檔 Kill Source '刪除已壓縮完的檔案 Loop
    2009年10月8日 上午 01:54
  • 使用shell指令具有wait的功能_visualbasic教程

    應該是壓縮需要時間,沒等它做完就刪除,就無法得到壓縮檔,需要Sleep幾秒或參考以上...
    2009年10月8日 上午 02:52
  • 哦  原來是這樣 

    好的 謝謝你 我在試試看

    那VB6 有直接刪除某資夾內的所有檔案的 語法嗎?

    2009年10月8日 上午 02:57
  • Kill "*.*"

    這個可以嗎...
    2009年10月8日 上午 03:05
  • Windows 是多工系統,當你用 Shell 呼叫其他程式時,是變成各跑各的。

    所以有可能是你 VB6 跑到 Kill Source 時,你的 rar 還沒產生完壓縮檔,就會造成被讀取跟正在產生的壓縮檔鎖定無法存取。

    正確來說,你應該等待 rar 跑完。

    Shell 傳回的是 ProcessId (PID) :
    ProcessId = Shell(xxx)

    你可以參考下面程式碼等待呼叫的程序關閉:
    http://msdn.microsoft.com/en-us/library/aa287951(VS.71).aspx

    論壇是網友平等互助 保證解答請至 微軟技術支援服務
    2009年10月8日 上午 03:12
  • 你可以查查伴隨 VBScript 5.5 以後的新物件:
    FileSystemObject (FSO)
    http://msdn.microsoft.com/zh-tw/library/aa711216(VS.71).aspx

    裡面有砍目錄的功能。

    注意:大概 2002 ~ 2004 間,曾有防毒軟體預設會阻擋 FSO 物件,現在比較沒聽說哪套會擋。


    論壇是網友平等互助 保證解答請至 微軟技術支援服務
    2009年10月8日 上午 03:19
  • 再次  謝謝兩位
    2009年10月8日 上午 03:38
  • Private Declare Function OpenProcess Lib _
       "kernel32" (ByVal dwDesiredAccess As Long, _
       ByVal bInheritHandle As Long, _
       ByVal dwProcessID As Long) As Long
    Private Declare Function WaitForSingleObject _
       Lib "kernel32" (ByVal hHandle As Long, _
       ByVal dwMilliseconds As Long) As Long
    Private Declare Function CloseHandle Lib _
       "kernel32" (ByVal hObject As Long) As Long
    
    
    
    Dim Filenames As String
    
    Filenames = Dir("d:\moni\CKL\")
    
    Do While Filenames <> ""
    
    File = Mid(Filenames, 1, 3)
    
    Source = "d:\moni\CKL\" + Filenames
    
    Target = "d:\moni\單位正式下傳目錄\分會檔\" + File + ".rar"
    
    'Shell "rar a " + Target + " " + Source + ""  
    
    pid = Shell("rar a " + Target + " " + Source + "", vbNormalFocus)
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)
    ExitEvent = WaitForSingleObject(hProcess, INFINITE)
    Call CloseHandle(hProcess)
    
    Filenames = Dir '再次呼叫dir函数,此時可以不帶參數
    
    Kill Source '刪除已壓縮完的檔案
    
    Loop
    小弟參考說明後 將程式修改過了

    但是實際去執行的結果 依舊無法順利產生壓縮檔

    但在等待時間那 已經設了 INFINITE

    不知道 是哪邊有問題

    還請幫小弟解惑一下...

    謝謝
    2009年10月8日 上午 06:45
  • INFINITE是定義-1還是&HFFFF?檢查ExitEvent為0,壓縮算完成,才進行接下來的步驟刪檔,實際壓縮需時幾秒?INFINITE那裡改設1000~5000試試...
    2009年10月8日 上午 07:05
  • 不好意思 小弟看不懂您前面說的意思 ,我有改過INFINITE 依然不行

    而目前實際壓縮時間 應該很短  只是放一個空的文字檔去給他壓而已
    2009年10月8日 上午 07:28
  • 'Error on call
    Private Const WAIT_FAILED = -1& 
    'Normal completion
    Private Const WAIT_OBJECT_0 = 0 
    'Timeout period elapsed
    Private Const WAIT_TIMEOUT = &H102& 
    
    Public Function WaitForProcessClose(ByVal PID _
       As Long, ByVal TimeOut As Long) As Boolean
       ' Timeout needs to be passed in milliseconds!
       Dim hProc As Long
       Dim nRet As Long
       Const fdwAccess = SYNCHRONIZE
    
       ' Try opening process; wait on it to close.
       hProc = OpenProcess(fdwAccess, False, PID)
    
       If hProc Then
          nRet = WaitForSingleObject(hProc, TimeOut)
          Select Case nRet
             Case WAIT_TIMEOUT
                ' Still open.
                WaitForProcessClose = False
             Case WAIT_OBJECT_0
                ' Process has closed.
                WaitForProcessClose = True
             Case Else
                ' Error on call.
                WaitForProcessClose = False
                ApiErrorDump Err.LastDllError, _
                   "WaitForSingleObject"
          End Select
    

    請問INFINITE您有設過那些值不行呢?心冷大貼的網址有檢查為0,壓縮才算做完,才能去做刪檔的動作,所以回傳值為多少呢...
    2009年10月8日 上午 07:36
  • 我用 msgbox ExitEvent 得到的值 為-1

    INFINITE 我從1000   5000  9999  10000  到更大的數字都有試過了
    2009年10月8日 上午 07:41
  • 你 VB6 有沒有更新到 SP6 ?
    VB6 SP2 以前,傳回的是 TaskId ,之後才改為 PID ,所以線上手冊還改。原線上手冊內容如下:

    Shell 函數

    R執行一個執行檔程式,如果成功的話,會傳回一個 Variant (Double) 來代表這個程式的 task ID,若不成功,則會傳回 o。

    語法

    Shell(pathname[,windowstyle])


    論壇是網友平等互助 保證解答請至 微軟技術支援服務
    2009年10月8日 上午 07:48
  • 補充,傳回 -1 要用 Err.LastDllError 檢查,通常是你的 hProc 不正確。
    論壇是網友平等互助 保證解答請至 微軟技術支援服務
    2009年10月8日 上午 07:50
  • 恩 找到原因了 

    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0, pid)

    改成

    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION+SYNCHRONIZE, 0, pid)

    就可以了 


    謝謝兩位

    2009年10月8日 上午 09:34