Database Search

TechHome

• Auto Sum Two Columns In Excel
• Basic iteration of Slicers in Excel
• Check if Workbook Contains a Macro
• Combine XLS Workbooks using ADO
• Determine if XLS File is Password Protected
• Read Excel Cells Into WIL Dialog
• Remove Duplicate Records in Excel
• RemoveDuplicates

Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.

Check if Workbook Contains a Macro

 Keywords: Check Determine Workbook Macro Code

;Winbatch 2010A - UDF to check if workbook contains macro code
;script should work with earlier versions, but does use :
;rather than StrCat()
;
;Stan Littlefield May 16, 2010
;////////////////////////////////////////////////////////////////////////////////////////////

GoSub udfs
IntControl(73,1,0,0,0)
oXL=0
opnxls()
Exit

:WBERRORHANDLER
If isObject(oXL) Then oXL.Quit()
oXL=0
ErrorProcessing(1,1,0,0)
Exit

;////////////////////////////////////////////////////////////////////////////////////////////
:udfs
#DefineSubRoutine opnxls()
IntControl(73,1,0,0,0)
types="Excel Files|*.xls|"
cXLS=AskFilename("Select Workbook", "", types, "", 1)
If ! FileExist(cXLS) Then Exit

oXL = CreateObject("Excel.Application")
If oXL == 0 Then Exit
oXL.Visible          = 1
oXL.ScreenUpdating   = 1
oXL.UserControl      = 1
oXL.DisplayAlerts    = 0
nOld = oXL.SheetsInNewWorkbook
oXL.SheetsInNewWorkbook = 1
oXL.WorkBooks.Open(cXLS)
oWKB = oXL.ActiveWorkBook
check4code()
oXL.ActiveWorkBook.Close()
oXL.Quit()
oXL=0
Return(1)

:WBERRORHANDLER
If isObject(oXL) Then oXL.Quit()
oXL=0
ErrorProcessing(1,1,0,0)
Exit

:CANCEL
Exit
#EndSubRoutine


#DefineSubRoutine check4code()
;Note: this can also be used on an existing Excel Object
;      with multiple workbooks open.
;      just modify with outer  ForEach oWKB in oXL.WorkBooks
;                                 ForEach c In oWKB.VBProject.VBComponents
;                                 Next
;                              Next
IntControl(73,1,0,0,0)
msg1 = "There is code in: ":@CRLF
msg2 = "There is no code in: ":@CRLF
isMacro=0
ForEach c In oWKB.VBProject.VBComponents
   isMacro = isMacro || c.CodeModule.Find("End", 1, 1, 1, 1)
Next
If isMacro Then
   msg = msg1:oWKB.Name:@CRLF  ;or msg = StrCat(msg1,oWKB.Name,@CRLF)
Else
   msg = msg2:oWKB.Name:@CRLF
EndIf
Message("",msg)
Return(1)

:WBERRORHANDLER
If isObject(oXL) Then oXL.Quit()
oXL=0
ErrorProcessing(1,1,0,0)
Exit
#EndSubRoutine

#DefineFunction isObject(obj)
Return(VarType(obj)>=1024)
#EndFunction

#DefineSubRoutine ErrorProcessing(deleteIni,showerr,logfile,Err_Array)
If VarType(Err_Array) ==256
   WbError = Err_Array[0]
   wberrorhandlerline = Err_Array[1]
   wberrorhandleroffset = Err_Array[2]
   wberrorhandlerassignment = Err_Array[3]
   wberrorhandlerfile = Err_Array[4]
   wberrortextstring = Err_Array[5]
   wberroradditionalinfo = Err_Array[6]
   wberrorinsegment = Err_Array[7]
Else
   WbError = LastError()
EndIf
WbTextcode = WbError
If WbError==1668||WbError==2669||WbError==3670
   WbError = ItemExtract(1,IntControl(34,-1,0,0,0),":")
   WbTextcode = -1
EndIf
WbErrorString = IntControl(34,WbTextcode,0,0,0)
WbErrorDateTime = TimeYmdHms()
If deleteIni
   WbErrorFile = StrCat(ShortCutDir( 'AppData', 0, 0 ),'\WinBatch\Settings\')
   If ! DirExist(WbErrorFile) Then WbErrorFile = DirWindows(0)
   WbErrorFile = StrCat(WbErrorFile,"WWWBATCH.INI")
   FileDelete(WbErrorFile)
   IniWritePvt(WbErrorDateTime,"CurrentScript",WbErrorHandlerFile      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorValue"   ,WbError                 ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ErrorString"  ,WbErrorString           ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptLine"   ,WbErrorHandlerLine      ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"ScriptOffset" ,WbErrorHandlerOffset    ,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarAssignment",WbErrorHandlerAssignment,WbErrorFile)
   IniWritePvt(WbErrorDateTime,"VarInSegment" ,WbErrorInSegment,WbErrorFile)
   IniWritePvt("","","",WbErrorFile)
EndIf
WbErrorMsgText = StrCat(WbErrorDateTime,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Current Script: ",WbErrorHandlerFile,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error# [",WbError,"]",@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"Error Text: ",wberrortextstring,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"[Extended Information] ",wberroradditionalinfo,@CRLF,@CRLF)
WbErrorMsgText = StrCat(WbErrorMsgText,"On Line:",@CRLF,WbErrorHandlerLine,@CRLF)
;WbErrorMsgText = StrCat(WbErrorMsgText,"Offset: ",WbErrorHandlerOffset,@CRLF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "UNKNOWN"
WbErrorMsgText = StrCat(WbErrorMsgText,"Assignment/Variable: ",WbErrorHandlerAssignment,@CRLF)
If (WbErrorInSegment>"") Then WbErrorMsgText = StrCat(WbErrorMsgText,"In UDF/UDS: ",WbErrorInSegment,@CRLF)
If logfile
   cSep = StrCat(StrFill("=",50),@CRLF)
   cLogFile = StrCat(DirScript(),"log.err")
   If ! FileExist(cLogFile) Then FilePut(cLogFile,StrCat("Error Log",@CRLF,cSep))
   FilePut(cLogFile,StrCat(FileGet(cLogFile),WbErrorMsgText,cSep))
   Display(2,"An Error Occured",StrCat("written to ",cLogFile))
Else
   If showerr
      WbErrorMsgText = StrCat(WbErrorMsgText,"[THIS ERROR NOT WRITTEN TO LOG FILE]",@CRLF)
      Message("An Error Was Encountered",WbErrorMsgText)
   EndIf
EndIf
Return(1)
#EndSubRoutine


Return
;////////////////////////////////////////////////////////////////////////////////////////////

Article ID:   W18116

Filename:   Check if Workbook Contains a Macro.txt

File Created: 2010:05:17:08:58:48

Last Updated: 2010:05:17:08:58:48