Code:
Option Explicit
' Marz 2020
Private Sub FileTypesHere_And_MaybeAlsoInDeviceManager()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: Set Rng = Ws.Range("D4:E300") 'Set Rng = Ws.Range("F4:G300") ' Set Rng = Ws.Range("D4:E75")
'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 Ddl2 As Long, Sys2 As Long, Bin2 As Long, Cpa2 As Long, Vp2 As Long
Dim Bag2 As Long, Xml2 As Long, Js2 As Long, Gdl2 As Long, Cab2 As Long, Ini2 As Long
Dim Cat2 As Long, Inf2 As Long, Pnf2 As Long, Gpd2 As Long, Exe2 As Long
Dim Dpb As Long, Ppd As Long
Dim Dpb2 As Long, Ppd2 As Long
Rem 3 Looping
Dim ClCnt As Long, RwCnt As Long
Dim rngStr As Range
For Each rngStr In Rng
' For RwCnt = 1 To UBound(arrFiles(), 1)
' For ClCnt = 1 To UBound(arrFiles(), 2)
'If arrFiles(RwCnt, ClCnt) = "" Then
If rngStr.Value = "" 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
If InStr(2, rngStr.Value, ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
' Get the extension
Dim Xtn As String
'Let Xtn = Mid(arrFiles(RwCnt, ClCnt), (InStr(2, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) + 1))
Let Xtn = Mid(rngStr.Value, (InStr(2, rngStr.Value, ".", vbBinaryCompare) + 1))
Select Case UCase(Xtn)
Case "SYS"
Let Sys = Sys + 1: If rngStr.Font.Color <> 0 Then Let Sys2 = Sys2 + 1
Case "DLL"
Let Ddl = Ddl + 1: If rngStr.Font.Color <> 0 Then Let Ddl2 = Ddl2 + 1
Case "BIN"
Let Bin = Bin + 1: If rngStr.Font.Color <> 0 Then Let Bin2 = Bin2 + 1
Case "CPA"
Let Cpa = Cpa + 1: If rngStr.Font.Color <> 0 Then Let Cpa2 = Cpa2 + 1
Case "VP"
Let Vp = Vp + 1: If rngStr.Font.Color <> 0 Then Let Vp2 = Vp2 + 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: If rngStr.Font.Color <> 0 Then Let Bag2 = Bag2 + 1
Case "XML"
Let Xml = Xml + 1: If rngStr.Font.Color <> 0 Then Let Xml2 = Xml2 + 1
Case "JS"
Let Js = Js + 1: If rngStr.Font.Color <> 0 Then Let Js2 = Js2 + 1
Case "GDL"
Let Gdl = Gdl + 1: If rngStr.Font.Color <> 0 Then Let Gdl2 = Gdl2 + 1
Case "CAB"
Let Cab = Cab + 1: If rngStr.Font.Color <> 0 Then Let Cab2 = Cab2 + 1
Case "INI"
Let Ini = Ini + 1: If rngStr.Font.Color <> 0 Then Let Ini2 = Ini2 + 1
Case "CAT"
Let Cat = Cat + 1: If rngStr.Font.Color <> 0 Then Let Cat2 = Cat2 + 1
' Inf As Long, Pnf As Long, Gpd As Long, Exe as long
Case "INF"
Let Inf = Inf + 1: If rngStr.Font.Color <> 0 Then Let Inf2 = Inf2 + 1
Case "PNF"
Let Pnf = Pnf + 1: If rngStr.Font.Color <> 0 Then Let Pnf2 = Pnf2 + 1
Case "GPD"
Let Gpd = Gpd + 1: If rngStr.Font.Color <> 0 Then Let Gpd2 = Gpd2 + 1
Case "EXE"
Let Exe = Exe + 1: If rngStr.Font.Color <> 0 Then Let Exe2 = Exe2 + 1
' Dim Dpb As Long, Ppd As Long
Case "DPB"
Let Dpb = Dpb + 1: If rngStr.Font.Color <> 0 Then Let Dpb2 = Dpb2 + 1
Case "PPD"
Let Ppd = Ppd + 1: If rngStr.Font.Color <> 0 Then Let Ppd2 = Ppd2 + 1
Case Else
Debug.Print "Case Else " & rngStr.Value ' arrFiles(RwCnt, ClCnt)
Let Els = Els + 1
End Select
Else ' not a file path, or rather not a . in
Dim Fldr As Long: Let Fldr = Fldr + 1
End If
End If
' Next ClCnt
' Next RwCnt
Next rngStr
Rem 4 output
Debug.Print "sys " & Sys & " (" & Sys2 & ")"
Debug.Print "dll " & Ddl & " (" & Ddl2 & ")"
Debug.Print "bin " & Bin & " (" & Bin2 & ")"
Debug.Print "cpa " & Cpa & " (" & Cpa2 & ")"
Debug.Print "vp " & Vp & " (" & Vp2 & ")"
Debug.Print "els " & 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 & " (" & Bag2 & ")"
Debug.Print "xml " & Xml & " (" & Xml2 & ")"
Debug.Print "js " & Js & " (" & Js2 & ")"
Debug.Print "gdl " & Gdl & " (" & Gdl2 & ")"
Debug.Print "cab " & Cab & " (" & Cab2 & ")"
Debug.Print "ini " & Ini & " (" & Ini2 & ")"
Debug.Print "cat " & Cat & " (" & Cat2 & ")"
' Inf As Long, Pnf As Long, Gpd As Long, Exe as long
Debug.Print "inf " & Inf & " (" & Inf2 & ")"
Debug.Print "pnf " & Pnf & " (" & Pnf2 & ")"
Debug.Print "gpd " & Gpd & " (" & Gpd2 & ")"
Debug.Print "exe " & Exe & " (" & Exe2 & ")"
' Dim Dpb As Long, Ppd As Long
Debug.Print "dpb " & Dpb & " (" & Dpb2 & ")"
Debug.Print "ppd " & Ppd & " (" & Ppd2 & ")"
Debug.Print "Total files is " & Sys + Ddl + Bin + Cpa + Vp + Bag + Xml + Js + Gdl + Cab + Ini + Cat + Inf + Pnf + Gpd + Exe + Dpb + Ppd
Debug.Print "Things with no . are " & Fldr
End Sub
Reply With Quote
Bookmarks