DetectType

Public Function GetFileType(xFile As String) As String
  On Error Resume Next
  Dim ID As String * 300
  If Dir$(xFile) = "" Then
     GetFileType = "NOT FOUND"
     Exit Function
  End If

Open xFile For Binary Access Read As #1
     Get #1, 1, ID
  Close #1
  
  If Left(ID, 2) = "MZ" Or Left(ID, 2) = "ZM" Then
     GetFileType = "PE Executable"
     Exit Function
  ElseIf Left(ID, 1) = "[" And InStr(1, Left(ID, 100), "]") > 0 Then
     GetFileType = "INI File"
     Exit Function
  ElseIf Mid(ID, 9, 8) = "AVI LIST" Then
     GetFileType = "AVI Movie File"
     Exit Function
  ElseIf Left(ID, 4) = "RIFF" Then
     GetFileType = "WAV Audio File"
     Exit Function
  ElseIf Left(ID, 4) = Chr(208) & Chr(207) & Chr(17) & Chr(224) Then
     GetFileType = "Microsoft Word Document"
     Exit Function
  ElseIf Mid(ID, 5, 15) = "Standard Jet DB" Then
     GetFileType = "Microsoft Access Database"
     Exit Function
  ElseIf Left(ID, 3) = "GIF" Or InStr(1, ID, "GIF89") > 0 Then
     GetFileType = "GIF Image File"
     Exit Function
  ElseIf Left(ID, 1) = Chr(255) And Mid(ID, 5, 1) = Chr(0) Then
     GetFileType = "MP3 Audio File"
     Exit Function
  ElseIf Left(ID, 2) = "BM" Then
     GetFileType = "BMP (Bitmap) Image File"
     Exit Function
  ElseIf Left(ID, 3) = "II*" Then
     GetFileType = "TIFF Image File"
     Exit Function
  ElseIf Left(ID, 2) = "PK" Then
     GetFileType = "ZIP Archive File"
     Exit Function
  ElseIf InStr(1, LCase(ID), "<html>") > 0 Or InStr(1, LCase(ID), "<!doctype") > 0 Then
     GetFileType = "HTML Document File"
     Exit Function
  ElseIf UCase(Left(ID, 3)) = "RAR" Then
     GetFileType = "RAR Archive File"
     Exit Function
  ElseIf Left(ID, 2) = Chr(96) & Chr(234) Then
     GetFileType = "ARJ Archive File"
     Exit Function
  ElseIf Left(ID, 3) = Chr(255) & Chr(216) & Chr(255) Then
     GetFileType = "JPEG Image File"
     Exit Function
  ElseIf InStr(1, ID, "Type=") > 0 And InStr(1, ID, "Reference=") > 0 Then
     GetFileType = "Visual Basic Project File"
     Exit Function
  ElseIf Left(ID, 8) = "VBGROUP " Then
     GetFileType = "Visual Basic Group Project File"
     Exit Function
  ElseIf Left(ID, 8) = "VERSION " & InStr(1, ID, vbCrLf & "Begin") > 0 Then
     GetFileType = "Visual Basic Form File"
     Exit Function
  Else
 'Unknown file... make a weak attempt to 
 'determine if the file is text or binary

If InStr(1, ID, Chr$(255)) > 0 Or InStr(1, ID, _
     Chr$(1)) > 0 Or InStr(1, ID, Chr$(2)) > 0 Or _
     InStr(1, ID, Chr$(3)) > 0 Then
     GetFileType = "Unknown binary file"
  Else
     GetFileType = "Unknown text file"
  End If
  Exit Function
  End If
End Function Inputs:
'Public Function GetFileType(xFile As String)
'xFile is the full path:\filename of the file to test.

Returns:
Returns a string indicating the filetype, or if the 
file is an unknown text or unknown binary file.

Public Function GetFileType(xFile As String) As String
On Error Resume Next
Dim ID As String * 300
If Dir$(xFile) = "" Then
GetFileType = "NOT FOUND"
Exit Function
End If

Open xFile For Binary Access Read As #1
Get #1, 1, ID
Close #1

If Left(ID, 2) = "MZ" Or Left(ID, 2) = "ZM" Then
GetFileType = "PE Executable"
Exit Function
ElseIf Left(ID, 1) = "[" And InStr(1, Left(ID, 100), "]") > 0 Then
GetFileType = "INI File"
Exit Function
ElseIf Mid(ID, 9, 8) = "AVI LIST" Then
GetFileType = "AVI Movie File"
Exit Function
ElseIf Left(ID, 4) = "RIFF" Then
GetFileType = "WAV Audio File"
Exit Function
ElseIf Left(ID, 4) = Chr(208) & Chr(207) & Chr(17) & Chr(224) Then
GetFileType = "Microsoft Word Document"
Exit Function
ElseIf Mid(ID, 5, 15) = "Standard Jet DB" Then
GetFileType = "Microsoft Access Database"
Exit Function
ElseIf Left(ID, 3) = "GIF" Or InStr(1, ID, "GIF89") > 0 Then
GetFileType = "GIF Image File"
Exit Function
ElseIf Left(ID, 1) = Chr(255) And Mid(ID, 5, 1) = Chr(0) Then
GetFileType = "MP3 Audio File"
Exit Function
ElseIf Left(ID, 2) = "BM" Then
GetFileType = "BMP (Bitmap) Image File"
Exit Function
ElseIf Left(ID, 3) = "II*" Then
GetFileType = "TIFF Image File"
Exit Function
ElseIf Left(ID, 2) = "PK" Then
GetFileType = "ZIP Archive File"
Exit Function
ElseIf InStr(1, LCase(ID), "<html>") > 0 Or InStr(1, LCase(ID), "<!doctype") > 0 Then
GetFileType = "HTML Document File"
Exit Function
ElseIf UCase(Left(ID, 3)) = "RAR" Then
GetFileType = "RAR Archive File"
Exit Function
ElseIf Left(ID, 2) = Chr(96) & Chr(234) Then
GetFileType = "ARJ Archive File"
Exit Function
ElseIf Left(ID, 3) = Chr(255) & Chr(216) & Chr(255) Then
GetFileType = "JPEG Image File"
Exit Function
ElseIf InStr(1, ID, "Type=") > 0 And InStr(1, ID, "Reference=") > 0 Then
GetFileType = "Visual Basic Project File"
Exit Function
ElseIf Left(ID, 8) = "VBGROUP " Then
GetFileType = "Visual Basic Group Project File"
Exit Function
ElseIf Left(ID, 8) = "VERSION " & InStr(1, ID, vbCrLf & "Begin") > 0 Then
GetFileType = "Visual Basic Form File"
Exit Function
Else
'Unknown file... make a weak attempt to

'determine if the file is text or binary

If InStr(1, ID, Chr$(255)) > 0 Or InStr(1, ID, _
Chr$(1)) > 0 Or InStr(1, ID, Chr$(2)) > 0 Or _
InStr(1, ID, Chr$(3)) > 0 Then
GetFileType = "Unknown binary file"
Else
GetFileType = "Unknown text file"
End If
Exit Function
End If
End Function Inputs:
'Public Function GetFileType(xFile As String)

'xFile is the full path:\filename of the file to test.

Returns:
Returns a string indicating the filetype, or if the
file is an unknown text or unknown binary file.