Need to scan xls files and identify if they use macros...wanna use VB

J

Jim Hicks

I was given a project to scan all of the Excel files on our network and
generate a report listing the
files and wether they use Macros. I was thinking of using VB6 to scann all
dirs/subdirs...easy part.
Question: -- How do I quickly scan an excel file and determine if it
has/uses Macros using VB6.
I appreciate you taking the time to read this and any help anybody can
provide. Thanks.
 
J

james.igoe

I was on a project to do something similar, and besides an automated
chaeck, there was a need to have each Excel file with potential
code/upgrade issues checked. I believe there is a HasMacro bit you can
check on each file.

Also, if that doesn't exist, you can count the lines of the modules,
trim the empty space, then have a some criteria where the string needs
to be greater than some small value to qualify as having code.


James Igoe

[email protected] || http://code.comparative-advantage.com
 
N

NickHK

Jim,
A quick look at Excel files seems to indicate macro code adds
_VBA_PROJECT_CUR to the workbook in Unicode as 56 00 42 00 41 00 etc...
It would certainly be quicker to find this in a binary read of the file than
to open all WB, but I'm not sure how reliable this is.
There is also the issue of the old Macro sheet. Do you need to test for them
?

NickHK
 
J

Jim Hicks

I am not sure, we have saved these files with Excel 97 and 2000 versions
over the years.
Unicode huh?

OK. well it looks like there may be 3 possibilities so far:

1. A Binary read of the file converted to Unicode searched for
"_VBA_PROJECT_CUR "
2. Set Macro security to low and open the files in VB checking If
wb.VBProject.VBComponents(wb.CodeName). _
CodeModule.CountOfLines
3. I believe there is a HasMacro bit you can check on each file. Also, if
that doesn't exist, you can count the lines of the modules,
trim the empty space, then have a some criteria where the string needs to be
greater than some small value to qualify as having code.

Thanks again for the help everybody.
I will try to test some of these options later today if I get the chance. If
anybody has any info on pitfalls to avoid while implementing this let us
know... I will post the results and code I tried later.
 
P

Peter T

A quick look at Excel files seems to indicate macro code adds
_VBA_PROJECT_CUR to the workbook

An interesting observation Nick. But also in a quick look it seems to be
included in any file that was saved while the vbide was open even a file
without code, but it's also included files with code saved while the vbide
was closed.

Option Explicit

Function FilesToCol(sPath As String, c As Collection) As Long
Dim sFile As String

sFile = Dir(sPath & "*.xls")
Do While Len(sFile)
c.Add sFile
sFile = Dir()
Loop
FilesToCol = c.Count

End Function
Sub Test()
Dim sFolder As String
Dim col As Collection
Dim i As Long

Set col = New Collection
sFolder = Application.DefaultFilePath & "\" '"C:\Temp\"

If FilesToCol(sFolder, col) = 0 Then
MsgBox "No *.xls in " & sFolder
Exit Sub
End If

ReDim va(1 To col.Count, 1 To 2)

For i = 1 To col.Count 'col.Count
va(i, 1) = col(i)
va(i, 2) = hasCode(sFolder & col(i))
Next

Range("a1").Resize(UBound(va), 2).Value = va
End Sub


Function hasCode(sFile As String) As Variant
Dim FF As Integer
Dim i As Long, j As Long
Dim cnt As Long
Dim ba() As Byte
Dim by() As Byte

ba() = "_VBA_PROJECT_CUR"
FF = FreeFile

On Error GoTo errH

Open sFile For Binary As FF
ReDim by(LOF(FF) - 1)
Get FF, , by()
Close FF

For i = 0 To UBound(by)
If by(i) = 95 Then '"_"
For j = 0 To UBound(ba) Step 2
If by(i + j) <> ba(j) Then Exit For
Next
If j = UBound(ba) + 1 Then
hasCode = True
Exit Function
'' or comment above & return cnt of occurrences
' cnt = cnt + 1
End If
End If
Next
' hasCode = cnt

Exit Function
errH:
'Stop
Close FF
End Function

For me the file running this code returned cnt 2, all others 1 or 0
In theory shouldn't 'Open' an already open file but it doesn't seem to do
any harm

I think you are on the right lines and halfway there. Any more obervations
to adapt into the above demo?

Regards,
Peter T

PS Hmm I appear to be about to send this to multiple NG's, why...
 
N

NickHK

Peter,
I didn't examine it too closely, but what you say seems to be true. It would
flag some files falsely, which could then be filtered out at the next level.
At least it would ignore all files without code and would be much faster
than opening each .xls.

NickHK
 
J

Jim Hicks

Origional Question:

How do I quickly scan an excel file and determine if it has/uses Macros
using VB6?

Where we are so far:

With the help of JLatham, NickHK, PFLugs and Peter T (sorry if I missed
anyone) I have thrown together the following program(I am using VB6).
As you can see there are different results in both scans, I also had to put
error handling in WorkbookHasVBACode and doIhavecode
to keep it running when I get errors trying to open some xls files. I
scanned about 100 files and recieved mixed results with both differnet macro
scans.
Also, I had problems with some of the code. Specifically: understanding the
filestocol function, the end of the line If by(i) = 95 Then '"_"
removing the hascode="true" in the same section and using cnt. and also the
section from PFlugs about adding setting Macro security. I have excel 2000
but am doing this in VB6
Also I didn't see the reference in excel for this (all blank)

If anybody would like to try this the whole program is included, I know it
doesn't use the best practices, and probably has a few bugs...for the most
part it is functional and I hope with a little work and the right info it
can be made reliable. Thanks again everybody for helping a noob.

CODE:::::
add the "microsoft common dialog control6 sp3" component
check the "microsoft excel 9.0 object library" reference

main form objects xlscanner.frm
add all the objects below to the main form xlscanner.frm

drive1 - drivelistbox
dir1 -dirlistbox
file1 -filelistbox
listview1 -listviewbox set
properties-view=3,multiselect=checked,allowcolumnreorder=checked,

fullrowselect=checked,sorted=checked with 4 column headers.
1=path,2=filename,3=macro,4=macro2
text1 -textbox with label next to stating "will be scanning"
label5 label with empty text field
text3 textbox
text2 textbox
includesubdirs checkbox with label next to stating "include subdirectories"
report checkbox with label stating "generate report to
"c:\xlsreport.txt"
scandirbutton command button labeled "Scan Directory"
processbutton command button labeled "process files"
exitbutton command button labeled "exit"



add a secondary form called "reading.frm" no code, just have a small form
that has a label with "reading" in a big font


a general module with the following...I know....
Public sPath$
Public tmpary(100000) As String
Public tyhdpath(100000) As String
Public tyhdpath2(100000) As String
Public tmparycnt
Public tyhd(100000) As String
Public tyhdcnt
Public tmp1$
Public flag2$


this is the code for the main form:xlscanner.frm
(just paste into the xlscanner.frm)




Sub DoIHaveCode()
Dim HasCodeResult As Boolean

On Error GoTo ErrorHandler

HasCodeResult = WorkbookHasVBACode(ActiveWorkbook)
Worksheets("Sheet1").Activate


ErrorHandler:

End Sub
Function WorkbookHasVBACode(wb As Workbook) As Boolean
'adapted from
'http://j-walk.com/ss/excel/tips/tip70.htm
'by J. Walkenbach
'
flag2$ = "Error"
On Error GoTo ErrorHandler

WorkbookHasVBACode = False ' default
If wb.VBProject.VBComponents(wb.CodeName). _
CodeModule.CountOfLines > 0 Then
WorkbookHasVBACode = True
flag2$ = "True"

End If


If wb.VBProject.VBComponents(wb.CodeName). _
CodeModule.CountOfLines = 0 Then
WorkbookHasVBACode = False
flag2$ = "False"
End If

ErrorHandler:


End Function

Function hasCode(sFile As String) As Variant
Dim FF As Integer
Dim i As Long, j As Long
Dim cnt As Long
Dim ba() As Byte
Dim by() As Byte

ba() = "_VBA_PROJECT_CUR"
FF = FreeFile

On Error GoTo errH

Open sFile For Binary As FF
ReDim by(LOF(FF) - 1)
Get FF, , by()
Close FF

For i = 0 To UBound(by)
If by(i) = 95 Then '"_"
For j = 0 To UBound(ba) Step 2
If by(i + j) <> ba(j) Then Exit For
Next
If j = UBound(ba) + 1 Then
hasCode = True
Exit Function
'' or comment above & return cnt of occurrences
' cnt = cnt + 1
End If
End If
Next
' hasCode = cnt

Exit Function
errH:
'Stop
Close FF

End Function
Private Sub processbutton_Click()
'scan the selected files

reading.Show
main.Enabled = False

DoEvents
If report.Value = 1 Then Open "C:\xlsreport.txt" For Output As #1



ListView1.ListItems.Clear
'start main loop - process all files in array
For l = 1 To tyhdcnt
tmp1$ = tyhdpath(l) + tyhd(l)
Text2.Text = tmp1$
'copy file to temp location so it doesn't get messed up
tmp1d$ = "c:\temp\" + tyhd(l)
FileCopy tmp1$, tmp1d$


'process temp file



Text3.Text = tmp1d$

'call hascode function macro scan 1
tmp2$ = hasCode(tmp1d$)


'call workbookhasvbacode function macro scan 2
Workbooks.Open FileName:=tmp1d$, ReadOnly:=True, UpdateLinks:=0,
Notify:=False


'tmp2$ = WorkbookHasVBACode(ActiveWorkbook)
Call DoIHaveCode


Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True





'set to true or false from hascode function
If tmp2$ <> "True" Then tmp2$ = "False"
'write to report on c:\xlsreport.txt
If report.Value = 1 Then Print #1, tyhdpath(l) + tyhd(l) + "," + tmp2$ + ","
+ flag2$
'add items to listview1 box with color as they are processed
Set list_item = ListView1.ListItems.Add(, , tyhdpath(l))
If tmp2$ = "True" Then list_item.ForeColor = vbRed Else list_item.ForeColor
= vbGreen
Set list_sub = list_item.ListSubItems.Add
If tmp2$ = "True" Then list_sub.ForeColor = vbRed Else list_sub.ForeColor =
vbGreen
Set list_sub2 = list_item.ListSubItems.Add
If tmp2$ = "True" Then list_sub2.ForeColor = vbRed Else list_sub2.ForeColor
= vbGreen
list_item.SubItems(1) = tyhd(l)
If tmp2$ <> "True" Then list_item.SubItems(2) = "False" Else
list_item.SubItems(2) = "True"
Set list_sub3 = list_item.ListSubItems.Add
If flag2$ = "True" Then list_sub3.ForeColor = vbRed
If flag2$ = "False" Then list_sub3.ForeColor = vbGreen
If flag2$ = "Error" Then list_sub3.ForeColor = vbBlack
list_item.SubItems(3) = flag2$
DoEvents

Kill tmp1d$

Next l
Close #1
reading.Hide
main.Enabled = True
main.Show

End Sub
Private Sub scandirbutton_Click()
'clicked scan the dir----this will create an array of only the excel files
'check includesubdirs.value for subdirs-stores xls files in array
tyhdpath(tyhdcnt)
tyhdcnt = 0
ListView1.ListItems.Clear

tmparycnt = 0
reading.Show
main.Enabled = False

DoEvents

'get files from just this dir, subdir not checked
If main.includesubdirs.Value = 0 Then
For l = 0 To File1.ListCount
tyhdcnt = tyhdcnt + 1
'save path
tyhdpath(tyhdcnt) = sPath$
'save filename
tyhd(tyhdcnt) = File1.List(l)
tyhd(tyhdcnt) = Trim(tyhd(tyhdcnt))

'check to see if xls=set to "" and don't add this one if not
tmp2$ = (Right$(tyhd(tyhdcnt), 3))
tmp2$ = UCase$(tmp2$)
If tmp2$ <> "XLS" Then tyhdcnt = tyhdcnt - 1
DoEvents
Next l
End If
DoEvents

'get files from this dir and all subdirs
If main.includesubdirs.Value = 1 Then
scnpth = sPath$
ListAllFilesInAllSubDirs (scnpth)

'loop through results of file list to remove non-xls and blank and add to
main array
tyhdcnt = 0

For l = 0 To tmparycnt
tmpary(l) = Trim(tmpary(l))
goodfile = 1
If tmpary(l) = "" Then goodfile = 0
'check to see if xls don't add this one if not
tmp2$ = (Right$(tmpary(l), 3))
tmp2$ = UCase$(tmp2$)
If tmp2$ <> "XLS" Then goodfile = 0
If goodfile = 1 Then
tyhdcnt = tyhdcnt + 1
instring$ = tyhdpath2(l)
Begin7:
instring$ = Replace(instring$, "\\", "\")
If (Replace(instring$, "\\", "\") <> instring$) Then GoTo Begin7
instring$ = Trim(instring$)
tyhdpath2(l) = instring$
tyhd(tyhdcnt) = tmpary(l)
tyhdpath(tyhdcnt) = tyhdpath2(l)

End If
Next l
End If
goodfile = 1
reading.Hide
main.Enabled = True
main.Show
DoEvents
'print to listview1 for review
For l = 1 To tyhdcnt
tmp1$ = tyhdpath(l) + tyhd(l)
Set list_item = ListView1.ListItems.Add(, , tyhdpath(l))
list_item.SubItems(1) = tyhd(l)



Next l
'update total items counter
Text1.Text = ListView1.ListItems.Count




tmp1$ = Str(tyhdcnt) + " :Files Selected"
Label5.Caption = tmp1$
If tyhdcnt > 0 Then processbutton.Visible = True
End Sub
Private Sub ListAllFilesInAllSubDirs(ByVal strStartingDir As String)
'Recursive function to traverse a directory tree.
Dim dir_names() As String
Dim num_dirs As Integer
Dim i As Integer
Dim strFileName As String
Dim attr As Integer
On Error Resume Next
' tmparycnt = 0
' Get the files in the current directory.
strFileName = Dir(strStartingDir & "\" & "*.*", vbNormal)
Do While strFileName <> ""
'Do something with the file
tmparycnt = tmparycnt + 1
'use variables for tydb and tycnt for flexibility
tmpary(tmparycnt) = strFileName
'need path saved in array for deletion
tyhdpath2(tmparycnt) = strStartingDir & "\"
tyhdpath2(tmparycnt) = Trim(tyhdpath2(tmparycnt))
tmpary(tmparycnt) = Trim(tmpary(tmparycnt))
If tmpary(tmparycnt) = "" Then tmparycnt = tmparycnt - 1
strFileName = Dir()

Loop
' Get the list of the subdirectories in this directory
strFileName = Dir(strStartingDir & "\*.*", vbDirectory)
Do While strFileName <> ""
' Skip this dir and its parent.
attr = 0 ' In case there's an error.
attr = GetAttr(strStartingDir & "\" & strFileName)
If strFileName <> "." And _
strFileName <> ".." And _
(attr And vbDirectory) <> 0 Then
num_dirs = num_dirs + 1
ReDim Preserve dir_names(1 To num_dirs)
dir_names(num_dirs) = strFileName
End If
strFileName = Dir()
Loop
' Search all the other subdirectories.
For i = 1 To num_dirs ' The recursion bottoming out condition
' This is the recursive line
ListAllFilesInAllSubDirs strStartingDir & "\" & dir_names(i)
Next i
DoEvents

End Sub
Private Sub Dir1_Change()
'changed dir-set scan path-update drive,dir and file boxes
sPath$ = Trim$(Dir1.Path): File1.Path = sPath$
'check for trailing "\" and add if missing
If Right$(sPath$, 1) <> "\" Then sPath$ = sPath$ + "\"
'Update textbox to show dir to scan
Text1.Text = sPath$
End Sub
Private Sub Drive1_Change()
'changed drive-set scan path-update drive,dir and file boxes
Dir1.Path = Drive1.Drive: sPath$ = Dir1.Path: sPath$ = Trim$(sPath$):
File1.Path = sPath$
'check for trailing "\" and add if missing
If Right$(sPath$, 1) <> "\" Then sPath$ = sPath$ + "\"
'Update textbox to show dir to scan
Text1.Text = sPath$
End Sub
Private Sub exitbutton_Click()
'exit
End
End Sub
Private Sub Form_Load()
processbutton.Visible = False
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As
MSComctlLib.ColumnHeader)
'performs sort on either column
If ListView1.SortOrder = lvwAscending Then
ListView1.SortOrder = lvwDescending
Else: ListView1.SortOrder = lvwAscending
End If
ListView1.SortKey = ColumnHeader.Index - 1
End Sub
 
P

Peter T

Also, I had problems with some of the code. Specifically:
understanding the || filestocol function, the end of the
line || If by(i) = 95 Then '"_" || removing
the hascode="true" in the same section and using cnt.
|| and also the section from PFlugs about adding setting Macro security.

I've inserted pairs of vertical pipes in your quote to try and understand
which parts of functions you have problems with. I'm not sure if "the end of
the line" relates to the 'filestocol' function or 'If by(i) = 95'

The 'filestocol' is a simple way of adding *.xls files in the given folder
to a collection for use in the calling proc. It returns count of the
collection, ie no of .xls files so if zero nothing to do. It could be
adapted to produce a tree like structure including sub-folders but there are
other methods, eg using File Scripting.

'If by(i) = 95' in hasCode(). This function should be named
"MightHaveCode()". I flung it together to test Nick's observation of
"_VBA_PROJECT_CUR" as Unicode in the file and quicker to do a binary read.
Unicode, briefly two bytes per character, an "A" would open in a text editor
as chr(65) & chr(0) "A" followed by unprintable square).

Could have opened the file into a pre 'spaced' string but much faster
to put into a byte array by() and loop.

ba() = "_VBA_PROJECT_CUR" populates this array with pairs of bytes

If by(i) = 95 Then

Ah, this byte represents a "_", so loop to see if ALL the following match
those in ba(). Step 2 'cos only concerned with the first of each pair of
bytes. If any don't match get out and continue the main loop. But if we get
to the end it fully matches. Can exit the function now returning True. I
left in commented code not to exit but continue to the end and return a
count of how many times the string exists in the file. That's why the
function as written returns a variant, boolean or long. However there's no
need to bother with getting a full count (unless want to do further checks
for other things).

As it turns out the absence of that unicode string proves no code exists but
its inclusion doesn't prove it does. However the function can be used as an
extremely fast filter something like this

If Not MightHaveCode(file) then
mark this file as safe, no need to examine further
Else
open in Excel and check count of lines / inserted modules
End if

I assume there must be some other flag of some sort in the file to confirm
existence of code. In a quick look thought I found it with HelpFile=. This
is not Unicode so test in the function like this

dim bb() as byte
dim bGotHelpFile as boolean
bb() = StrConv("HelpFile=", vbFromUnicode)
'code
'ba() the file

If by(i) = bb(0) Then
For j = 1 To UBound(bb)
If by(i + j) <> bb(j) Then Exit For
Next
If j = UBound(bb) + 1 Then
bGotHelpFile = True
End If
End If

But unfortunately I later found code files that did not include that string.
It would be worth examining files further to find something that's exclusive
to files with code.

I haven't tried to recreate your VB6 project and only glanced at your code.
Seems overly complex but if you have to resort to opening files need to be
careful as unknown files might do unpredictable things. In VB6 make the
excel
instance visible. Start with a new visible wb and disable events.

Set a wb reference to the file to each file you open and something like this
(only if MightHaveCode)

loop the list of suspect files
set wb = xlApp.workbooks open(blah)

bDefinatelygotcode = vbpHasCode(wb)
'store result
wb.close false

Function vbpHasCode(wb As Excel.Workbook) As Boolean
Dim oVBComp As Object ' VBComponent with ref to vb extensibility
Dim bGotCode As Boolean

For Each oCodeMod In wb.VBProject.VBComponents
If oCodeMod.Type = 100 Then 'vbext_ct_document
bGotCode = oCodeMod.CodeModule.CountOfLines
Else
'inserted module
bGotCode = True
End If
If bGotCode Then Exit For
Next
vbpHasCode = bGotCode
End Function

Sub test() ' vba
Dim wb As Workbook
For Each wb In Application.Workbooks
Debug.Print wb.Name, vbpHasCode(wb)
Next
End Sub

PFlug's comment about additional macro security relates to anything to do
with extensibility as in the above function, but not in XL2000.

Regards,
Peter T
 
N

NickHK

Jim,
If you are feeling masochistic, you could read through
http://sc.openoffice.org/excelfileformat.pdf (page 179 may be useful) and
pull the info.
But unless you are looking at 1000s of file every week, I don't think this
is the way to go.

NickHK

Peter T said:
I've inserted pairs of vertical pipes in your quote to try and understand
which parts of functions you have problems with. I'm not sure if "the end of
the line" relates to the 'filestocol' function or 'If by(i) = 95'

The 'filestocol' is a simple way of adding *.xls files in the given folder
to a collection for use in the calling proc. It returns count of the
collection, ie no of .xls files so if zero nothing to do. It could be
adapted to produce a tree like structure including sub-folders but there are
other methods, eg using File Scripting.

'If by(i) = 95' in hasCode(). This function should be named
"MightHaveCode()". I flung it together to test Nick's observation of
"_VBA_PROJECT_CUR" as Unicode in the file and quicker to do a binary read.
Unicode, briefly two bytes per character, an "A" would open in a text editor
as chr(65) & chr(0) "A" followed by unprintable square).

Could have opened the file into a pre 'spaced' string but much faster
to put into a byte array by() and loop.

ba() = "_VBA_PROJECT_CUR" populates this array with pairs of bytes

If by(i) = 95 Then

Ah, this byte represents a "_", so loop to see if ALL the following match
those in ba(). Step 2 'cos only concerned with the first of each pair of
bytes. If any don't match get out and continue the main loop. But if we get
to the end it fully matches. Can exit the function now returning True. I
left in commented code not to exit but continue to the end and return a
count of how many times the string exists in the file. That's why the
function as written returns a variant, boolean or long. However there's no
need to bother with getting a full count (unless want to do further checks
for other things).

As it turns out the absence of that unicode string proves no code exists but
its inclusion doesn't prove it does. However the function can be used as an
extremely fast filter something like this

If Not MightHaveCode(file) then
mark this file as safe, no need to examine further
Else
open in Excel and check count of lines / inserted modules
End if

I assume there must be some other flag of some sort in the file to confirm
existence of code. In a quick look thought I found it with HelpFile=. This
is not Unicode so test in the function like this

dim bb() as byte
dim bGotHelpFile as boolean
bb() = StrConv("HelpFile=", vbFromUnicode)
'code
'ba() the file

If by(i) = bb(0) Then
For j = 1 To UBound(bb)
If by(i + j) <> bb(j) Then Exit For
Next
If j = UBound(bb) + 1 Then
bGotHelpFile = True
End If
End If

But unfortunately I later found code files that did not include that string.
It would be worth examining files further to find something that's exclusive
to files with code.

I haven't tried to recreate your VB6 project and only glanced at your code.
Seems overly complex but if you have to resort to opening files need to be
careful as unknown files might do unpredictable things. In VB6 make the
excel
instance visible. Start with a new visible wb and disable events.

Set a wb reference to the file to each file you open and something like this
(only if MightHaveCode)

loop the list of suspect files
set wb = xlApp.workbooks open(blah)

bDefinatelygotcode = vbpHasCode(wb)
'store result
wb.close false

Function vbpHasCode(wb As Excel.Workbook) As Boolean
Dim oVBComp As Object ' VBComponent with ref to vb extensibility
Dim bGotCode As Boolean

For Each oCodeMod In wb.VBProject.VBComponents
If oCodeMod.Type = 100 Then 'vbext_ct_document
bGotCode = oCodeMod.CodeModule.CountOfLines
Else
'inserted module
bGotCode = True
End If
If bGotCode Then Exit For
Next
vbpHasCode = bGotCode
End Function

Sub test() ' vba
Dim wb As Workbook
For Each wb In Application.Workbooks
Debug.Print wb.Name, vbpHasCode(wb)
Next
End Sub

PFlug's comment about additional macro security relates to anything to do
with extensibility as in the above function, but not in XL2000.

Regards,
Peter T
---------------- CUT --------
 
J

Jim Hicks

Wow, a ton of information...I will have to look through your post fully
later on.

I wanted to make a couple of points about my code example.
First, it uses the c:\temp directory and copies any files to be scanned to
c:\temp and processes those, then deletes the temp file in c:\temp-won't
mess the origional.
Second, the Listallfilesinallsubdirs sub was obtained online a couple of
years ago, i don't know who origionally authored it but thanks.

Thanks again for the help on this...
 
P

Peter T

Not sure how I put this typo in Function vbpHasCode. To match with the
declaration change -
For Each oCodeMod In wb.VBProject.VBComponents
to
For Each oVBComp In wb.VBProject.VBComponents

Function vbpHasCode(wb As Excel.Workbook) As Boolean
Dim oVBComp As Object ' VBComponent with ref to vb extensibility
Dim bGotCode As Boolean

For Each oCodeMod In wb.VBProject.VBComponents
If oCodeMod.Type = 100 Then 'vbext_ct_document
bGotCode = oCodeMod.CodeModule.CountOfLines
Else
'inserted module
bGotCode = True
End If
If bGotCode Then Exit For
Next
vbpHasCode = bGotCode
End Function

Regards,
Peter T
 
J

Jim Hicks

Peter,

So just that one instance, and not any other oCodeMod references (like the 2
lines after) right?

Boy, I have alot to look at now to catch up...
 
N

NickHK

Jim,
I'll throw this in as well for the hell of it. Not a VB/VBA solution but...
OpenOffice can open Excel file and has a macro language.
You could open in this and see if there is any VBA code. I don't know enough
about their macro language to say if you can read the module code, but it is
certainly still there.
You would not have to be concerned about any code running, because it
wouldn't

NickHK
 
J

Jim Hicks

Nick,

Thanks for the info. I was looking through the HUGE openoffice info file
before I came to the newsgroups. Lots of info, didn't get anywhere.
I would like to automate this and generate a report, later I will check it
out as there might be some scripting or something you can use with
openoffice.
Right now though, I will continue with the VB soloution.....

Good point though, How vulnerable am I to malicious code in the current VB
program I am using? (see earlier post for code)
Well, one function is just a file read and the other opens the workbook...

I also noticed F-Secure's free (tm)(c) F-Macro.exe macro scanner when I
initially started this endevor. It scanns Macros in Excel files and
generates a report, however, it does not state which files have Macros.
 
P

Peter T

How vulnerable am I to malicious code in the current VB

It's an interesting general point. I have never received such a file, either
individually or of the mass virus type. Neither have I read any reports of
one being in circulation since the mid-late nineties (in contrast to 1000's
of Word.docs).

Hope this is not famous last words and wouldn't suggest anyone doesn't take
normal precautions. Not least as bad code can do bad things even if not with
malicious intent.

Regards,
Peter T

PS plonk a coffee cup on your shift key whilst opening all those files!
 
Top