Shell with an array result - check items 1 by 1

[theta]

Hi...trying a quick project for the weekend. Need to build a tool to run through an array of files and open as text stream, checking the first few characters to predefined list.

I am trying to find files that have been incorrectly named (extension).

The array will be using the method put on here by another member snb? :

[vba]
aryFiles = Split(CreateObject("WScript.Shell").exec("cmd /c dir " & RegKeyDir & "\*.*" & " /ad /b /s").stdout.readall, vbCrLf)
[/vba]

A loop should then initialise and go through the array one item at a time opening each item as text stream (maybe just first 5 characters for speed).

If the characters do not match the extension of the file then it should be added to a new array, which will then be dumped onto a workbook e.g.

First 2 chars are 'PK' > Extension should be .zip
First 2 chars are 'BM' > Extension should be .bmp
First few chars are 'ÿØÿà JFIF' > Extension should be .jpg or .jpeg

We could be looking at thousands of files so what is the most efficient coding/loop for this? I can leave the PC to run through this for a few hours.

[Kenneth Hobs]

You can play with this. Be sure to set the two references that I commented.

I used both the WScript method to read a file and the VBA method. Obviously, you could use the fso method to read text in a file as well.

[VBA]Sub FileTypes()
Dim aryFiles() As String, RegKeyDir As String
Dim v As Variant, iFN As Integer, s As String
' Tools > References > Microsoft Scripting Runtime
Dim fso As Scripting.FileSystemObject
Dim f As Scripting.File

' Tools > References > Windows Script Host Object Model
Dim ws As WshShell
Set ws = New WshShell
Set fso = New Scripting.FileSystemObject

RegKeyDir = ThisWorkbook.Path 'No trailing backslash.
'aryFiles() = Split(CreateObject("WScript.Shell").exec("cmd /c dir " & RegKeyDir & "\*.*" & " /b /s").stdout.readall, vbCrLf)
aryFiles() = Split(ws.exec("cmd /c dir " & RegKeyDir & "\*.*" & " /b /s").StdOut.readall, vbCrLf)
ReDim Preserve aryFiles(UBound(aryFiles) - 1)
'MsgBox Join(aryFiles(), vbCrLf)

On Error GoTo NextV
For Each v In aryFiles()
If LCase(v) <> LCase(ThisWorkbook.FullName) Then
Set f = fso.GetFile(v)
iFN = FreeFile
Open v For Input As #iFN
Input #iFN, s
Close #iFN
Debug.Print f.Name, Left(s, 10)
End If
NextV:
Next v

Set f = Nothing
Set fso = Nothing
End Sub[/VBA]