2016-11-14 104 views
1

我有這段代碼可以瀏覽VBA中的所有文件類型。它已經在工作,但我現在想要做的是刪除數組中的項目,如果它是被阻止的文件類型之一。刪除數組中的項目

Const exts = _ 
    ".ade.adp.app.asp.bas.bat.cer.chm.cmd.com.cpl.crt.csh.der.exe.fxp.gadget" & _ 
    ".hlp.hta.inf.ins.isp.its.js.jse.ksh.lnk.mad.maf.mag.mam.maq.mar.mas.mat" & _ 
    ".mau.mav.maw.mda.mdb.mde.mdt.mdw.mdz.msc.msh.msh1.msh2.mshxml.msh1xml" & _ 
    ".msh2xml.ade.adp.app.asp.bas.bat.cer.chm.cmd.com.cpl.crt.csh.der.exe.fxp" & _ 
    ".gadget.hlp.hta.msi.msp.mst.ops.pcd.pif.plg.prf.prg.pst.reg.scf.scr.sct" & _ 
    ".shb.shs.ps1.ps1xml.ps2.ps2xml.psc1.psc2.tmp.url.vb.vbe.vbs.vsmacros.vsw" & _ 
    ".ws.wsc.wsf.wsh.xnk." 

file = Application.GetOpenFilename(MultiSelect:=True, Title:="Select the files you want to zip") 
If IsArray(file) = True Then 
    'Create empty Zip File 
ReDim Data(1 To UBound(file) + 1, 1 To 1) 
efCount = Empty 

' filter the list 
For j = LBound(file) To UBound(file) 
    ext = LCase(Mid(file(j), InStrRev(file(j), "."))) 
    If InStr(1, exts, ext & ".") = 0 Then ' if not blacklisted 
     count = count + 1 
     Data(count, 1) = file(j) 
    Else 
     ReDim Preserve excludedFile(efCount) 
     excludedFile(efCount) = Dir(file(j)) 
     efCount = efCount + 1 
     file(j - 1) = file(j) 'Ive tried this and other ways bu is not working 
     found = True 
    End If 
Next 

感謝您的幫助。

+0

爲什麼不使用詞典,其易於操作? –

+0

@PankajJaju還沒有嘗試過,我仍然無法使用它。謝謝。 – ramj

+0

或[System.Collections.ArrayList](http://stackoverflow.com/questions/13585660/lists-in-vbscript)(只有Windows我猜) – SBF

回答

2

你可以去這樣

Dim file As Variant 
    Dim efCount As Long, j As Long, count As Long 
    Dim ext As String 
    Dim found As Boolean 

    Const exts = _ 
     ".ade.adp.app.asp.bas.bat.cer.chm.cmd.com.cpl.crt.csh.der.exe.fxp.gadget" & _ 
     ".hlp.hta.inf.ins.isp.its.js.jse.ksh.lnk.mad.maf.mag.mam.maq.mar.mas.mat" & _ 
     ".mau.mav.maw.mda.mdb.mde.mdt.mdw.mdz.msc.msh.msh1.msh2.mshxml.msh1xml" & _ 
     ".msh2xml.ade.adp.app.asp.bas.bat.cer.chm.cmd.com.cpl.crt.csh.der.exe.fxp" & _ 
     ".gadget.hlp.hta.msi.msp.mst.ops.pcd.pif.plg.prf.prg.pst.reg.scf.scr.sct" & _ 
     ".shb.shs.ps1.ps1xml.ps2.ps2xml.psc1.psc2.tmp.url.vb.vbe.vbs.vsmacros.vsw" & _ 
     ".ws.wsc.wsf.wsh.xnk." 

    file = Application.GetOpenFilename(MultiSelect:=True, Title:="Select the files you want to zip") 
    If IsArray(file) = True Then 
      'Create empty Zip File 
     ReDim Data(1 To UBound(file)) 
     ReDim excludedFile(1 To UBound(file)) 

     efCount = 0 
     ' filter the list 
     For j = LBound(file) To UBound(file) 
      ext = LCase(Mid(file(j), InStrRev(file(j), "."))) 
      If InStr(1, exts, ext & ".") = 0 Then ' if not blacklisted 
       count = count + 1 
       Data(count) = file(j) 
      Else 
       excludedFile(efCount + 1) = Dir(file(j)) 
       efCount = efCount + 1 
      End If 
     Next 
     found = efCount > 0 
    End If 
    ReDim Preserve Data(1 To count) 
    ReDim Preserve excludedFile(1 To efCount) 

    file = Data 
1

您可以使用函數從數組中刪除特定值。要把它放到你的項目:

Function DeleteElement(x As String, ByRef List() As String) ' As String 
    Dim i As Integer, el As Integer 
    Dim Result() As String 

    ReDim Result(UBound(List) - 1) 

    For i = 0 To UBound(List) 
     If x = List(i) Then 
      el = i 
      Exit For 
     End If 
    Next i 

    For i = 0 To UBound(Result) 
     If i < el Then 
      Result(i) = List(i) 
     Else 
      Result(i) = List(i + 1) 
     End If 
    Next i 

    DeleteElement = Result 
End Function 

你可以用它喜歡這裏:

Sub test2() 
    Dim arr1(3) As String 

    arr1(0) = "A" 
    arr1(1) = "B" 
    arr1(2) = "C" 
    arr1(3) = "D" 
    arr2 = DeleteElement("B", arr1) 

End Sub