配列内のディレクトリを削除する

Question

私はすべてのファイルタイプを取得するこのコードを持っています。

Dim file as variant 
file = Application.GetOpenFilename("All Files, *.*", , "Select File", , True) 

次に、シート上のセルに印刷する必要があります。

​​

でも、最初に配列の内容を確認してください。配列にこのファイルタイプがある場合は、arraylistでそのファイルタイプを削除する必要があります。その後、このファイルが削除されるというメッセージが表示されます。

dim arr() as string 
arr = Split("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", "|") 

私はどこから始めなければならないのか分かりません。私は少し同じ問題here in this postを見つけましたが、私はそれを理解できません。ありがとう！

Answer 1

一つの方法は、拡張子が、それはInStrとブラックリストに存在しないことを確認するために、次のようになります。

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." 

Dim file As Variant 
file = Application.GetOpenFilename("All Files, *.*", , "Select File", , True) 

Dim i As Long, data(), count As Long, ext As String 
ReDim data(1 To UBound(file) + 1, 1 To 1) 

' filter the list 
For i = LBound(file) To UBound(file) 
    ext = LCase(Mid(file(i), InStrRev(file(i), "."))) 
    If InStr(1, exts, ext & ".") = 0 Then ' if not blacklisted 
    count = count + 1 
    data(count, 1) = file(i) 
    End If 
Next 

' copy the filtered list to the next available row in column "O" 
If count Then 
    With ThisWorkbook.Sheets("Main").Cells(Rows.count, "O").End(xlUp) 
    .Offset(1).Resize(count).Value = data 
    End With 
End If 

Answer 2

あなたはRegExpを使用することができ、迅速に

このコードはこれを行うにはvaraint配列がパス...ドット延長終了文字列を探しますので、に基づいてファイルを削除する可能性がある、あなたの現在のアレイよりも堅牢ですパス名ではなく、ファイルの種類

Sub B() 
Dim fName As Variant 
Dim objRegex As Object 
Dim lngCnt As Long 
Dim rng1 As Range 

Set objRegex = CreateObject("vbscript.regexp") 

On Error Resume Next 
fName = Application.GetOpenFilename("All Files, *.*", , "Select file", , True) 
If Err.Number <> 0 Then Exit Sub 
On Error GoTo 0 

With objRegex 
.Pattern = ".*\.(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)$" 
    `replace matching file types with blank array entries 
    For lngCnt = 1 To UBound(fName) 
     fName(lngCnt) = .Replace(fName(lngCnt), vbNullString) 
    Next 
End With 

Set rng1 = Cells(Rows.Count, 15).End(xlUp).Offset(1,0) 
'dump array to sheet 
rng1.Resize(UBound(fName), 1) = Application.Transpose(fName) 
` remove blank entries 
On Error Resume Next 
rng1.SpecialCells(xlCellTypeBlanks).Delete xlUp 
On Error GoTo 0 

End Sub