Try
OfficeFonts!
It searches a folder and it's subfolders for DOC, XLS and PPT-files and finds the used fonts.
It's just a binary file searcher, so if it finds too few fonts or spits out too much garbage,
change the line
If trash>531 ; > more garbage < less fonts.
Skrommel
;OfficeFonts.ahk
; Show what fonts Office document files use
;Skrommel @2006
#NoEnv
SetBatchLines,-1
If 1=
{
FileSelectFolder,folder,3,, OfficeFonts - 1 Hour Software - www.1HourSoftware.com
If folder=
{
MsgBox,0,OfficeFonts - 1 Hour Software - www.1HourSoftware.com, No folder selected
Return
}
}
Else
folder=%1%
TrayTip,OfficeFonts,Finding used fonts...
allfonts=
Loop,%folder%\*.*,0,1
{
If A_LoopFileExt Not In doc,xls,ppt
Continue
BinRead(A_LoopFileLongPath,data) ; By Laszlo at http://www.autohotkey.com/forum/topic4546.html
allfonts.=data
}
fonts=`n
Loop,Parse,allfonts,`n
{
IfNotInString,fonts,`n%A_LoopField%`n
fonts=%fonts%%A_LoopField%`n
}
StringTrimLeft,fonts,fonts,1
Sort,fonts
MsgBox,0,OfficeFonts - 1 Hour Software,%fonts%`nhttp://www.1HourSoftware.com
ExitApp
BinRead(file, ByRef data, n=0, offset=0) ; Originally by Laszlo at http://www.autohotkey.com/forum/topic4546.html
{
h := DllCall("CreateFile","Str",file,"Uint",0x80000000,"Uint",3,"UInt",0,"UInt",3,"Uint",0,"UInt",0)
IfEqual h,-1, SetEnv, ErrorLevel, -1
IfNotEqual ErrorLevel,0,Return,0 ; couldn't open the file
m = 0 ; seek to offset
IfLess offset,0, SetEnv,m,2
r := DllCall("SetFilePointerEx","Uint",h,"Int64",offset,"UInt *",p,"Int",m)
IfEqual r,0, SetEnv, ErrorLevel, -3
IfNotEqual ErrorLevel,0, {
t = %ErrorLevel% ; save ErrorLevel to be returned
DllCall("CloseHandle", "Uint", h)
ErrorLevel = %t% ; return seek error
Return 0
}
TotalRead = 0
data =
IfEqual n,0, SetEnv n,0xffffffff ; almost infinite
format = %A_FormatInteger% ; save original integer format
SetFormat Integer, Hex ; for converting bytes to hex
word=
found=0
trash=0
Loop %n%
{
oldc:=c
result := DllCall("ReadFile","UInt",h,"UChar *",c,"UInt",1,"UInt *",Read,"UInt",0)
If (!result or Read<1 or ErrorLevel)
Break
TotalRead += Read
If (c=0)
If ((oldc>=65 And oldc<=90) Or (oldc>=97 And oldc<=122) Or oldc=32)
word.=Chr(oldc)
Else
{
If found=0
{
If word Contains Times New Roman,Arial
{
found=1
trash=0
data=
}
}
If (StrLen(word)>2)
data.=word "`n"
word=
trash+=1
}
If found=1
If trash>531 ; > more garbage < less fonts
Break
}
IfNotEqual,ErrorLevel,0 , SetEnv,t,%ErrorLevel%
h := DllCall("CloseHandle", "Uint", h)
IfEqual h,-1, SetEnv, ErrorLevel, -2
IfNotEqual t,,SetEnv, ErrorLevel, %t%
SetFormat Integer, %format% ; restore original format
Totalread += 0 ; convert to original format
Return TotalRead
}
