Code:
Option Explicit
Private Sub FileTypesHereArrays()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: Set Rng = Ws.Range("A1:F4437")
Dim arrFiles() As Variant: Let arrFiles() = Rng.Value2
Rem 2 File extension types
Dim Ddl As Long, Sys As Long, Bin As Long, Cpa As Long, Vp As Long, Els As Long
Dim Bag As Long, Xml As Long, Js As Long, Gdl As Long, Cab As Long, Ini As Long
Dim Cat As Long, Inf As Long, Pnf As Long, Gpd As Long, Exe As Long
Dim Sam As Long
Dim Inf_loc As Long, Hlp As Long, Ntf As Long, Ppd As Long, Tbl As Long, Icc As Long, Dat As Long
Dim Dpb As Long, Cty As Long, Msc As Long, Xst As Long
Rem 3 Looping
Dim ClCnt As Long, RwCnt As Long
For RwCnt = 1 To UBound(arrFiles(), 1)
For ClCnt = 1 To UBound(arrFiles(), 2)
If ClCnt = 2 And arrFiles(RwCnt, ClCnt) <> "" Then ' case of folder path
Dim Fldr As Long ' Debug.Print "Folder? " & arrFiles(RwCnt, ClCnt)
Let Fldr = Fldr + 1
Let RwCnt = RwCnt + 1 ' this is naughty, but will stop us hitting the folder name as the columns increase
Else ' not a folder and if empty then not in column 2
If arrFiles(RwCnt, ClCnt) = "" Then
' Empty cell, so do nothing
Else ' Time to look at cell value
' If Left(arrFiles(RwCnt, ClCnt), 3) = "C:\" And InStr(4, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
If InStr(2, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
Dim Xtn As String: Let Xtn = Mid(arrFiles(RwCnt, ClCnt), (InStr(2, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) + 1)) ' this will give the text starting from after the first dot .
' this next section catches single . things
If Len(arrFiles(RwCnt, ClCnt)) - Len(Replace(arrFiles(RwCnt, ClCnt), ".", "")) = 1 Then ' case a single .
Select Case UCase(Xtn)
Case "SYS"
Let Sys = Sys + 1
Case "DLL"
Let Ddl = Ddl + 1
Case "BIN"
Let Bin = Bin + 1
Case "CPA"
Let Cpa = Cpa + 1
Case "VP"
Let Vp = Vp + 1
'Dim Bag As Long, Xml As Long, Js As Long, Gdl As Long, Cab As Long, Ini As Long, Cat As Long
Case "BAG"
Let Bag = Bag + 1
Case "XML"
Let Xml = Xml + 1
Case "JS"
Let Js = Js + 1
Case "GDL"
Let Gdl = Gdl + 1
Case "CAB"
Let Cab = Cab + 1
Case "INI"
Let Ini = Ini + 1
Case "CAT"
Let Cat = Cat + 1
' Inf As Long, Pnf As Long, Gpd As Long, Exe as long
Case "INF"
Let Inf = Inf + 1
Case "PNF"
Let Pnf = Pnf + 1
Case "GPD"
Let Gpd = Gpd + 1
Case "EXE"
Let Exe = Exe + 1
' sam
Case "SAM"
Let Sam = Sam + 1
'inf_loc Pnf HLP NTF Ppd TBL ICC DAT
Case "INF_LOC"
Let Inf_loc = Inf_loc + 1
Case "HLP"
Let Hlp = Hlp + 1
Case "NTF"
Let Ntf = Ntf + 1
Case "PPD"
Let Ppd = Ppd + 1
Case "TBL"
Let Tbl = Tbl + 1
Case "ICC"
Let Icc = Icc + 1
Case "DAT"
Let Dat = Dat + 1
'Dim Dpb As Long, Cty As Long, Msc As Long, Xst As Long
Case "DPB"
Let Dpb = Dpb + 1
Case "CTY"
Let Cty = Cty + 1
Case "MSC"
Let Msc = Msc + 1
Case "XST"
Let Xst = Xst + 1
Case Else
Debug.Print "Case Else for single "" . "" " & arrFiles(RwCnt, ClCnt)
Let Els = Els + 1
End Select
ElseIf Len(arrFiles(RwCnt, ClCnt)) - Len(Replace(arrFiles(RwCnt, ClCnt), ".", "")) = 2 Then ' a thing like hidscanner.dll.mui or sdstor.sys.mui
' this next section catches double . . things
Dim DllMui As Long, SysMui As Long, Els2 As Long
Select Case UCase(Xtn)
Case "DLL.MUI"
Let DllMui = DllMui + 1
Case "SYS.MUI"
Let SysMui = SysMui + 1
Case Else
Debug.Print "Case Else for double "" . . "" " & arrFiles(RwCnt, ClCnt)
Let Els2 = Els2 + 1
End Select
ElseIf Len(arrFiles(RwCnt, ClCnt)) - Len(Replace(arrFiles(RwCnt, ClCnt), ".", "")) > 2 Then
' this section catches strings with dots more than 2
Dim LtsDts As Long
Debug.Print "More than 2 dots -- " & arrFiles(RwCnt, ClCnt)
Let LtsDts = LtsDts + 1
End If
Else ' not a file, ( well no . in it anyway )
' Dim Fldr As Long
' Debug.Print "Folder? " & arrFiles(RwCnt, ClCnt)
' Let Fldr = Fldr + 1
End If
End If ' end of case empty cell
End If ' end of folder is counted based on "G:\" in column B
Next ClCnt
Next RwCnt
Rem 4 output
Debug.Print "sys " & Sys
Debug.Print "dll " & Ddl
Debug.Print "bin " & Bin
Debug.Print "cpa " & Cpa
Debug.Print "vp " & Vp
Debug.Print "Else1 " & Els
'Dim Bag As Long, Xml As Long, Js As Long, Gdl As Long, Cab As Long, Ini As Long, Cat As Long
Debug.Print "bag " & Bag
Debug.Print "xml " & Xml
Debug.Print "js " & Js
Debug.Print "gdl " & Gdl
Debug.Print "cab " & Cab
Debug.Print "ini " & Ini
Debug.Print "cat " & Cat
' Inf As Long, Pnf As Long, Gpd As Long, Exe as long
Debug.Print "inf " & Inf
Debug.Print "pnf " & Pnf
Debug.Print "gpd " & Gpd
Debug.Print "exe " & Exe
' sam
Debug.Print "sam " & Sam
' inf_loc Pnf HLP NTF Ppd TBL ICC DAT
Debug.Print "inf_loc " & Inf_loc
Debug.Print "pnf " & Pnf
Debug.Print "hlp " & Hlp
Debug.Print "ntf " & Ntf
Debug.Print "ppd " & Ppd
Debug.Print "tbl " & Tbl
Debug.Print "icc " & Tbl
Debug.Print "dat " & Dat
' Dim Dpb As Long, Cty As Long, Msc As Long, Xst As Long
Debug.Print "dpb " & Dpb
Debug.Print "cty " & Cty
Debug.Print "msc " & Msc
Debug.Print "xst " & Xst
' Dim DllMui As Long, SysMui As Long, Els2 As Long
Debug.Print "dll.mui " & DllMui
Debug.Print "sys.mui " & SysMui
Debug.Print "Else2 " & Els2
Debug.Print "Total files is " & Els + Sys + Ddl + Bin + Cpa + Vp + Bag + Xml + Js + Gdl + Cab + Ini + Cat + Inf + Pnf + Gpd + Exe + Els2 + DllMui + SysMui + Sam + Inf_loc + Hlp + Ntf + Ppd + Tbl + Icc + Dat + Dpb + Cty + Msc + Xst
Debug.Print "Total Folders is " & Fldr
Debug.Print "Total things with more than 2 dots is " & LtsDts
End Sub
Reply With Quote
Originally Posted by fixer
Bookmarks