ज़िप छोड़कर फ़ोल्डर में सभी फ़ाइलें ज़िप खुद को संग्रहीत

Question

मैं एक नव निर्मित .zip फ़ाइल में किसी फ़ोल्डर में सभी फ़ाइलें ज़िप करने के लिए इस कोड का उपयोग कर रहा: के रूप में मेरे समस्याओं के बिना

Dim FileNameZip, FolderName 
Dim filename As String, DefPath As String 
Dim oApp As Object 

(defining all paths needed) 

'Create empty Zip File 
NewZip (FileNameZip) 

Set oApp = CreateObject("Shell.Application") 
'Copy the files to the compressed folder 
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items 

'Keep script waiting until Compressing is done 
On Error Resume Next 
Do Until oApp.Namespace(FileNameZip).items.Count = oApp.Namespace(FolderName).items.Count 
    Application.Wait (Now + TimeValue("0:00:01")) 
Loop 

यह काम करता है रूप में लंबे समय लक्ष्य फ़ोल्डर उस फ़ोल्डर से अलग है जहां मेरी फ़ाइलें हैं।

लेकिन मैं एक समस्या है जब मैं एक फ़ोल्डर से सभी फाइलों को लेने के लिए, उन्हें .zip में डाल दिया और संग्रह एक ही फ़ोल्डर में उत्पन्न किया है की कोशिश - यह संग्रह बनाता है और फिर यह डाल करने के लिए कोशिश करता है अपने आप में, जो निश्चित रूप से विफल रहता है।

मैं इस नए नव निर्मित किए गए फ़ोल्डर से सभी फ़ाइलों को ज़िप करने का एक तरीका ढूंढ रहा हूं।

मैंने यहां देखा: https://msdn.microsoft.com/en-us/library/office/ff869597.aspx लेकिन यह बहुत आउटलुक-विशिष्ट दिखता है और मुझे नहीं पता कि यह विंडोज फ़ोल्डर में कैसे लागू करें।

Answer 1

बजाय जिप में जोड़ने से पहले सभी फ़ाइलें एक साथ जोड़ने के लिए, जो FileSystemObject साथ फ़ाइलों के माध्यम से आपके द्वारा बनाए गए ज़िप फ़ाइल, पाश में शामिल हैं और ज़िप फ़ाइल नाम के खिलाफ उनके नाम की तुलना करेंगे:

Sub AddFilesToZip() 

Dim fso As Object, zipFile As Object, objShell As Object 
Dim fsoFolder As Object, fsoFile As Object 
Dim timerStart As Single 
Dim folderPath As String, zipName As String 

folderPath = "C:\Users\darre\Desktop\New folder\" ' folder to zip 
zipName = "myzipfile.zip" ' name of the zip file 

Set fso = CreateObject("Scripting.FileSystemObject") ' create an fso to loop through the files 

Set zipFile = fso.CreateTextFile(folderPath & zipName) ' create the zip file 
zipFile.WriteLine Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0) 
zipFile.Close 

Set objShell = CreateObject("Shell.Application") 
Set fsoFolder = fso.GetFolder(folderPath) 

For Each fsoFile In fsoFolder.Files ' loop through the files... 

    Debug.Print fsoFile.name 
    If fsoFile.name <> zipName Then ' and check it's not the zip file before adding them 

     objShell.Namespace("" & folderPath & zipName).CopyHere fsoFile.Path 

     timerStart = Timer 
     Do While Timer < timerStart + 2 
      Application.StatusBar = "Zipping, please wait..." 
      DoEvents 
     Loop 

    End If 

Next 

' clean up 
Application.StatusBar = "" 
Set fsoFile = Nothing 
Set fsoFolder = Nothing 
Set objShell = Nothing 
Set zipFile = Nothing 
Set fso = Nothing 

MsgBox "Zipped", vbInformation 

End Sub 

Answer 2

मैं अस्थायी फ़ोल्डर में ज़िप फ़ाइल बनाउंगा और अंत में इसे गंतव्य फ़ोल्डर में ले जाऊंगा। उल्लेख करने के लायक दो नोट्स:

1- आइटम की गणना तब तक लूपिंग का दृष्टिकोण फ़ोल्डर में समान है और ज़िप फ़ाइल जोखिम भरा है, क्योंकि अगर ज़िप किसी व्यक्तिगत आइटम के लिए विफल रहता है, तो इसका परिणाम अनंत लूप होता है। इस कारण से जब तक ज़िप फ़ाइल को खोल से लॉक किया जाता है तब तक लूप को बेहतर होता है।

2- मैं Shell के साथ प्रारंभिक बाध्यकारी का उपयोग करूंगा क्योंकि देर से बाध्यकारी Shell32.Application कुछ इंस्टॉलेशन पर समस्याएं प्रतीत होती है। Microsoft Shell Controls and Automation

Sub compressFolder(folderToCompress As String, targetZip As String) 
    If Len(Dir(targetZip)) > 0 Then Kill targetZip 

    ' Create a temporary zip file in the temp folder 
    Dim tempZip As String: tempZip = Environ$("temp") & "\" & "tempzip1234.zip" 
    CreateObject("Scripting.FileSystemObject").CreateTextFile(tempZip, True).Write _ 
     Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) 

    ' compress the folder into the temporary zip file 
    With New Shell ' For late binding: With CreateObject("Shell32.Application") 
     .Namespace(tempZip).CopyHere .Namespace(folderToCompress).Items 
    End With 

    ' Move the temp zip to target. Loop until the move succeeds. It won't 
    ' succeed until the zip completes because zip file is locked by the shell 
    On Error Resume Next 
    Do Until Len(Dir(targetZip)) > 0 
     Application.Wait Now + TimeSerial(0, 0, 1) 
     Name tempZip As targetZip 
    Loop 
End Sub 

Sub someTest() 
    compressFolder "C:\SO\SOZip", "C:\SO\SOZip\Test.zip" 
End Sub 

Answer 3

मैं VBA के माध्यम से ज़िप करने के लिए तीसरे पक्ष उपकरण के बिना नियंत्रित करने के लिए कठिन हो पाया करने के लिए कोई संदर्भ जोड़ें, नीचे एक सीधा जवाब नहीं हो सकता है, लेकिन एक समाधान के रूप में सहायता कर सकते हैं। नीचे कोड का एक अंश है जिसे मैं एपब्स उत्पन्न करने के लिए उपयोग करता हूं जो एक अलग एक्सटेंशन के साथ ज़िप फ़ाइलों से कहीं ज्यादा नहीं हैं। यह ज़िप अनुभाग सैकड़ों रनों में कभी विफल नहीं हुआ।

Public Function Zip_Create(ByVal StrFilePath As String) As Boolean 
Dim FSO   As New FileSystemObject 
Dim LngCounter As Long 

If Not FSO.FileExists(StrFilePath) Then 
    'This makes the zip file, note the FilePath also caused issues 
    'it should be a local file, suggest root of a drive and then use FSO 
    'to open it 
    LngCounter = FreeFile 
    Open StrFilePath For Output As #LngCounter 
    Print #LngCounter, "PK" & Chr(5) & Chr(6) & String(18, vbNullChar) 
    Close #LngCounter 
End If 

Zip_Create = True 

End Function 

Public Function Zip_Insert(ByVal StrZipFilePath As String, ByVal StrObject As String) As Boolean 
Dim BlnYesNo   As Boolean 
Dim LngCounter   As Long 
Dim LngCounter2   As Long 
Dim ObjApp    As Object 
Dim ObjFldrItm   As Object 
Dim ObjFldrItms   As Object 
Dim StrContainer  As String 
Dim StrContainer2  As String 

If Procs.Global_IsAPC Then 

    'Create the zip if needed 
    If Not FSA.File_Exists(StrZipFilePath) Then 
     If Not Zip_Create(StrZipFilePath) Then 
      Exit Function 
     End If 
    End If 

    'Connect to the OS Shell 
    Set ObjApp = CreateObject("Shell.Application") 

     'Pause, if it has just been created the next piece of 
     'code may not see it yet 
     LngCounter2 = Round(Timer) + 1 
     Do Until CLng(Timer) > LngCounter2 
      DoEvents 
     Loop 

     'Divide the path and file 
     StrContainer = Right(StrObject, Len(StrObject) - InStrRev(StrObject, "\")) 
     StrObject = Left(StrObject, Len(StrObject) - Len(StrContainer)) 

     'Connect to the file (via the path) 
     Set ObjFldrItm = ObjApp.NameSpace(CVar(StrObject)).Items.Item(CVar(StrContainer)) 

      'Pauses needed to avoid all crashes 
      LngCounter2 = CLng(Timer) + 1 
      Do Until CLng(Timer) > LngCounter2 
       DoEvents 
      Loop 

      'If it is a folder then check there are items to copy (so as to not cause and error message 
      BlnYesNo = True 
      If ObjFldrItm.IsFolder Then 
       If ObjFldrItm.GetFolder.Items.Count = 0 Then BlnYesNo = False 
      End If 

      If BlnYesNo Then 

       'Take note of how many items are in the Zip file 

       'Place item into the Zip file 
       ObjApp.NameSpace(CVar(StrZipFilePath)).CopyHere ObjFldrItm 

       'Pause to stop crashes 
       LngCounter2 = CLng(Timer) + 1 
       Do Until CLng(Timer) > LngCounter2 
        DoEvents 
       Loop 

       'Be Happy 
       Zip_Insert = True 

      End If 

     Set ObjFldrItm = Nothing 

    Set ObjApp = Nothing 
End If 

End Function