Delete an item in an array

2019-07-23 08:43发布

I have this code that browse all file types in VBA. It's already working but my what I want to do now is to delete the item in the array if it is one of the blocked file types.

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

Thanks for the help.

2条回答
The star\"
2楼-- · 2019-07-23 09:04

you could go like this

    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
查看更多
兄弟一词,经得起流年.
3楼-- · 2019-07-23 09:17

You can use function to delete particular value from array. Put this into your project:

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

You can use it like here:

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
查看更多
登录 后发表回答