Automatically print pictures

hcl-bot · July 8, 2005, 6:13am

Hi

In our organization we need to perform the following operation:

We recieve mails regularily into a specified mailin db
As soon as the mails arrive, I want them to automtically be printed to designated printer

I assume that this must be done using LS in a before new mail arrives agent?

My question: is it possible to print pictures from arriving mails(they are not embedded files, but they show in the body field)? If yes, which LS classes can perform the print operation to the designated printer? Anyone hava som LS code for me to reuse?

Any help is deeply appreciated!

Henrik

hcl-bot · July 8, 2005, 12:44pm

Subject: Automatically print pictures

See below code and pick whatever you want to print pics I use Adobe(u need full version), this code is used to detach all attachments from mail in Main in db and print them from action button, this code handles word, excel, adobe, zip, jpeg etc… for pwd protected doc’s writes into log document. But don’t know, how to set default printed(u can do from notes print options). Sorry about mess in code.

'New Print Attachments Email:

Option Public

Option Explicit

Const MSG_AutomationError = "Unable to find application "

Const MSG_UnableToPrint = "Unable to print file "

Const MSG_Continue = “Click OK to Continue printing supported file types”

Const MSG_NoExtension = “No file extension”

Const MSG_UnknownExtension = “Extension not recognized”

Declare Function ShellExecute Lib “shell32.dll” Alias “ShellExecuteA” (Byval hwnd As Long, Byval lpszOp As String, Byval lpszFile As String, Byval lpszParams As String, _

Byval LpszDir As String, Byval FsShowCmd As Long) As Long

Const ERROR_FILE_NOT_FOUND = 2 ’ File not found

Const ERROR_PATH_NOT_FOUND = 3 ’ Path not found

Const SE_ERR_ACCESSDENIED = 5 ’ Access denied

Const SE_ERR_OOM = 8 ’ Not enough memory to complete the operation

Const ERROR_BAD_FORMAT = 11 ’ EXE file invalid

Const SE_ERR_SHARE = 26

Const SE_ERR_ASSOCINCOMPLETE = 27 ’ Filename association invalid or incomplete

Const SE_ERR_DDETIMEOUT = 28 ’ DDE timeout

Const SE_ERR_DDEFAIL = 29 ’ DDE failed

Const SE_ERR_DDEBUSY = 30 ’ DDE already busy

Const SE_ERR_NOASSOC = 31 ’ No application associated with this extension

Const SE_ERR_DLLNOTFOUND = 32

Dim EmailPrinted As String

Dim dbBPI As NotesDatabase

Dim doc As NotesDocument

'new reqd to add all attachments are not printed during print operation becoz of pwd issues or any other

Dim AttachmentsNotPrinted As String

Public Sub PrintAllAttachments (doc As NotesDocument)

%REM

Prints out attachments in the document

IN

doc, the Notes document

OUT

nothing

%END REM

Dim rtitem As notesrichtextitem



If doc Is Nothing Then Exit Sub

If doc.HasItem ("Body") = False Then Exit Sub

Set rtitem = doc.GetFirstItem( "Body" ) 

If ( rtitem.Type = RICHTEXT ) = False Then Exit Sub

'if no attachments, print Email

If Isempty(rtitem.EmbeddedObjects) Then Exit Sub



Forall o In rtitem.EmbeddedObjects ' loops through all attachments

	If ( o.Type = EMBED_ATTACHMENT ) Then 

		Call PrintAttachment (o, doc)

	End If

End Forall

End Sub

Private Sub PrintAttachment ( o As Variant, doc As NotesDocument)

%REM

Prints out the attachment.

If the extension is not supported or the application is not installed, messagebox to the user.

Notes:

We used OLE for Excel because ShellExecute only prints the first Worksheet.

With the OLE method, we print all worksheets.

We did not use OLE for Word and PowerPoint because these apps support several file extensions,

which we would have to hard-code. If needed, these methods can be used, they were tested.

IN

o, the NotesEmbeddedObject to print

OUT

nothing

%END REM

Dim fname As String

Dim Period As String

Dim FileExtension As String 

Dim ret As Integer

Dim zPath As String

On Error Goto errHandle



fname = GetTmpDir + o.Source

Period = Instr(1, fname, ".")

If Period = 0 Then 

	FileExtension = "" 

Else

	FileExtension = Mid$(fname, Period, 4)

End If

'Handling two dots in a file name

Dim FileExt2 As String

FileExt2$ = Right$(fname, 4)

Print FileExt2$

’ Select Case Lcase$(FileExtension)

’ Case “”

If Lcase$(FileExtension) = "" Then 		' Or donotPrint = "Yes" Then

	Print "No Extension or Census file" + fname

’ Case “.doc”

Elseif Lcase$(FileExtension) = ".doc" Or  Lcase$(FileExt2) = ".doc" Then

	Call o.ExtractFile ( fname )

	Call PrintMSWord (fname)

	Call DeleteDetachedFile (fname )

’ Case “.ppt”

Elseif Lcase$(FileExtension) = ".ppt" Or  Lcase$(FileExt2) = ".ppt" Then

	Call o.ExtractFile ( fname )

	Call PrintMSPowerPoint (fname)

	Call DeleteDetachedFile (fname )

’ Case “.pdf”

Elseif Lcase$(FileExtension) = ".pdf" Or  Lcase$(FileExt2) = ".pdf"  Then

	Call o.ExtractFile ( fname )

	Call PrintAdobe (fname)

	Call DeleteDetachedFile (fname )

’ Case “.tif”, “.jpg” , “.bmp” , “.gif” , “.jpeg”

	Elseif (Lcase$(FileExtension) = ".tif" Or Lcase$(FileExtension) = ".jpg" Or Lcase$(FileExtension) = ".bmp"_

	Or Lcase$(FileExtension) =  ".gif" Or Lcase$(FileExtension) =  ".jpeg")_

	Or (Lcase$(FileExt2) = ".tif" Or Lcase$(FileExt2) = ".jpg" Or Lcase$(FileExt2) = ".bmp"_

Or Lcase$(FileExt2) =  ".gif" Or Lcase$(FileExt2) =  ".jpeg")   Then

’ Call PrintTIF (fname)

	Call o.ExtractFile ( fname )

	Call PrintAdobe (fname)

	Call DeleteDetachedFile (fname )

'These file formats are not supported as requested

’ Case “.xls”

Elseif Lcase$(FileExtension) = ".xls" Or  Lcase$(FileExt2) = ".xls" Then

	Call o.ExtractFile ( fname )

	Call PrintMSExcel (fname, o.source) 

	Call DeleteDetachedFile (fname )

'new functionality for handling Zip files

Elseif Lcase$(FileExtension) = ".zip" Or  Lcase$(FileExt2) = ".zip" Then

	Call o.ExtractFile ( fname )

’ zPath = “C:\Data\Notes\temp\zip”

’ Call PrintZIp(o.source, zPath) '( fname )

	Call PrintZIp(o.source)                  '( fname )

’ Call DeleteDetachedFile (fname ) ’ this is commented becoz zip deleted before unzipped

’ Case “.prn”

’ Call PrintMSExcel (fname)

’ Call DeleteDetachedFile (fname )

’ Case Else

’ PrintDefault (fname)

’ Call DeleteDetachedFile (fname )

’ End Select

End If

Exit Sub

errHandle:

’ Msgbox "Error " + Cstr(Err) + ": " + Error$ + Chr$(13) + MSG_Continue, 16, MSG_UnableToPrint + fname

Print "Error " + Cstr(Err) + ": " + Error$ '  + Chr$(13) + MSG_Continue, 16, MSG_UnableToPrint + fname

Print("Could not print attachment: " & o.source)

'When error write into log info - 06/21/2005

'Call writelog(doc, fname)

AttachmentsNotPrinted = AttachmentsNotPrinted + "" + o.source + " - "	

Exit Sub

End Sub

Private Function GetTmpDir As String

%REM

Gets (if exists) or creates a temporary directory \temp in the Notes data directory

IN

Nothing.

OUT

Nothing.

RETURN

The temporary directory, terminated by ""

%END REM

On Error Goto TmpDirError



Dim s As New NotesSession

Dim TmpDir As String

'Directory is the Notes data Directory

TmpDir = s.GetEnvironmentString ("Directory", True)

TmpDir = TmpDir & "\temp"



If Dir$ (TmpDir , 16)="" Then

	Mkdir TmpDir

End If



TmpDir = TmpDir & "\"



GetTmpDir = TmpDir

Exit Function

TmpDirError:

On Error Goto 0

GetTmpDir = "c:\temp"

Exit Function

End Function

Private Sub PrintMSWord (fname As String)

Dim app As Variant 

Dim docToPrint As Variant

Dim PrintBackground As Integer

'new error handler is created to all types of errors, incl. pwd and automation object

On Error Goto errWord

’ On Error 208 Goto err208

’ On Error 213 Goto err213 'pwd issues write to log file

Set app = createobject("Word.application")

’ Set docToPrint = app.documents.open(fname) 'commented on 06/20/05

'added on 06/20/05 Syntax

’ Set docToPrint = app.documents.open(fname,Confirm Conversion,Read Only,AddToFies,“pwd”,PwdTemplate,

’ Revert,WritePwd,WritePwdTemplate,Format,Encoding,Visible,OpenConflictDoc,OpenAndRepair,DocDirection,NoEncodingDialog)

Set docToPrint = app.documents.open(fname,,,,"pwd",,,,,,,,,,)

’ Turn off background printing to avoid error message cf. Microsoft Technote #Q170393

PrintBackground = app.Options.PrintBackground()

If PrintBackground = True Then app.Options.PrintBackground = False 

Call docToPrint.PrintOut()

app.Options.PrintBackground = PrintBackground 'Restore PrintBackground option



Call app.Quit(0) 

Set app = Nothing

Exit Sub

errWord:

'when error write into log info - 06/21/2005

’ Call writelog(doc, fname)

’ AttachmentsNotPrinted = AttachmentsNotPrinted + “” + fname + " - "

AttachmentsNotPrinted = AttachmentsNotPrinted + "" +Mid$(fname, 20, (Len(fname)-19)) + " - "

Exit Sub

%REM

err208: 'Cannot create automation object

Msgbox MSG_AutomationError + "MS Word", 16, "Error " + Cstr(Err) + ": " + Error$

Print MSG_AutomationError + "MS Word"        ', 16, "Error " + Cstr(Err) + ": " + Error$

err213:

'when error write into log info - 06/21/2005

Call writelog(doc, fname)

Exit Sub

%ENDREM

End Sub

Private Sub PrintMSExcel (fname As String, shortname As String)

Dim app As Variant 

Dim docToPrint As Variant

'new error handler is created to all types of errors, incl. pwd and automation object

On Error Goto errExcel

’ On Error 208 Goto err208

’ On Error 213 Goto err213

Set app = createobject("Excel.application")

’ Set docToPrint = app.workbooks.open(fname)

'to avoid alerts for Enable macros

’ Dim secAutomation As MsoAutomationSecutiry

’ Dim MsoAutomationSecurityLow As String

'secAutomation = app.AutomationSecurity	

app.AutomationSecurity = 3 'MsoAutomationSecurityLow

’ app.msoAutomationSecurityLow

'open workbook as update links FALSE, Read Only True, Save

’ Set docToPrint = app.workbooks.open(fname,False,True,True)

Set docToPrint = app.workbooks.open(fname,False,True,,"pwd",,True)  ' added this stat for handling pwd protected

’ Set docToPrint = app.workbooks.open(fname,True,True)

                                                              '(fname,2,True,3,4,5,True,7,8,9,10,11,12,13,14,15)

’ No background printing option available for Excel, no need for special handling

Call docToPrint.PrintOut()

’ Call app.workbooks.close 'SaveChanges:=False

'close workbook w/o saving

Call app.workbooks(shortname).close(False)

Call app.Quit()

Set app = Nothing

Exit Sub

errExcel:

'when error write into log info - 06/21/2005

’ Call writelog(doc, fname)

’ AttachmentsNotPrinted = AttachmentsNotPrinted + “” +fname + " - "

AttachmentsNotPrinted = AttachmentsNotPrinted + "" +Mid$(fname, 20, (Len(fname)-19)) + " - "

Exit Sub

%REM

err208: 'Cannot create automation object

’ Msgbox MSG_AutomationError + “MS Excel”, 16, "Error " + Cstr(Err) + ": " + Error$

Print  MSG_AutomationError + "MS Excel"		', 16, "Error " + Cstr(Err) + ": " + Error$

err213:

'when error write into log info - 06/21/2005

Call writelog(doc, fname)

Exit Sub

%END REM

End Sub

Private Sub PrintMSPowerPoint (fname As String)

Dim app As Variant 

Dim docToPrint As Variant

Dim PrintBackground As Integer

Dim NewInstance As Integer

’ Because PowerPoint, unlike Word and Excel, only allows one instance cf. MS Technote #Q222783

On Error 208 Goto createObject

Set app = GetObject (, "PowerPoint.Application")

NewInstance = False

Goto objectCreated

createObject:

NewInstance = True

On Error 208 Goto err208

Set app = createobject("PowerPoint.application")

objectCreated:

app.visible = True ' app has to be visible, error message otherwise



Call app.presentations.open(fname)

’ Turn off background printing to avoid error message

Set docToPrint = app.ActivePresentation

PrintBackground = docToPrint.PrintOptions.PrintInBackground

If PrintBackground = True Then app.ActivePresentation.PrintOptions.PrintInBackground = False

Call docToPrint.PrintOut()

docToPrint.PrintOptions.PrintInBackground = PrintBackground 'Restore PrintBackground option

docToPrint.Close



If NewInstance = True Then Call app.Quit() ' Close application only if WE launched it

Set app = Nothing

Exit Sub

err208: 'Cannot create automation object

’ Msgbox MSG_AutomationError + “MS PowerPoint”, 16, "Error " + Cstr(Err) + ": " + Error$

Print MSG_AutomationError + "MS PowerPoint"		', 16, "Error " + Cstr(Err) + ": " + Error$

Exit Sub

End Sub

Private Sub PrintDefault (fname As String)

'Ref: Microsoft article Q170918

Dim hwnd As Long

Dim ret As Long

Dim msg As String

ret = ShellExecute(hwnd, "Print", fname, "", "", 0)

If ret<32 Then ' Error

	Select Case ret 

	Case ERROR_FILE_NOT_FOUND

		msg = "File not found"

	Case ERROR_PATH_NOT_FOUND

		msg = "Path not found"

	Case SE_ERR_ACCESSDENIED

		msg = "Access denied"

	Case SE_ERR_OOM

		msg = "Out of memory"

	Case SE_ERR_DLLNOTFOUND

		msg = "DLL not found"

	Case SE_ERR_SHARE

		msg = "A sharing violation occurred"

	Case SE_ERR_ASSOCINCOMPLETE

		msg = "Incomplete or invalid file association"

	Case SE_ERR_DDETIMEOUT

		msg = "DDE Time out"

	Case SE_ERR_DDEFAIL

		msg = "DDE transaction failed"

	Case SE_ERR_DDEBUSY

		msg = "DDE busy"

	Case SE_ERR_NOASSOC

		msg = "No association for file extension"

	Case ERROR_BAD_FORMAT

		msg = "Invalid EXE file or error in EXE image"

	Case Else

		msg = "Unknown error"

	End Select

’ Msgbox MSG_UnableToPrint + fname + Chr$(13) + MSG_Continue, 16, msg

	Print  MSG_UnableToPrint + fname 		'+ Chr$(13) + MSG_Continue, 16, msg

	Print("Could not print attachment: " & fname)		

Else		

	Print("Printing attachment : " & fname)		

End If

End Sub

Sub Initialize

'SGSR/SSR/SVP

'Program changed on 04/16 to replace msg box with print statement

’ Verify that at least 1 doc is selected

’ Last Modified 07/01/2005

Dim session As New NotesSession

Dim colSelected As NotesDocumentCollection

Dim mPrinted As String



Set dbBPI = session.CurrentDatabase

Set colSelected = dbBPI.UnprocessedDocuments

If colSelected.Count = 0 Then

	Messagebox "You must select a document to Print."

	Exit Sub

End If

On Error Goto ErrorRoutine

Set doc = colSelected.GetfirstDocument	



Do While Not doc Is Nothing 

	If doc.HasItem("mailPrinted") Then

		mprinted = doc.mailPrinted(0)

		If mPrinted = "No" Then	

			AttachmentsNotPrinted = ""

			Call PrintAllAttachments (doc)			

			Call PutStamp(session, dbBPI, doc)   

		Else 

			Print "This Email Printed previously!" + doc.subject(0)   

		End If

	Else

		AttachmentsNotPrinted = ""

		Call PrintAllAttachments (doc)			

		Call PutStamp(session, dbBPI, doc)

	End If

	

	Set doc = colSelected.GetNextDocument(doc)	

Loop			

Call session.SetEnvironmentVar( "FolderName", "")

Exit Sub

ErrorRoutine:

Print "Error in line " & Erl() & ", " & Error$

Exit Sub

End Sub

Sub DeleteDetachedFile (fname As String)

'Call delay delay before killing file to make sure file has time to finish printing and/or closing.

Kill fname 

Print "File detached deleted..." & fname

End Sub

Sub PrintAdobe (fname As String)

Dim AVDoc As Variant

Dim PDDoc As Variant

Dim AcroApp As Variant

’ On Error 208 Goto err208

’ On Error 213 Goto err213

On Error Goto AdobeErr	

Dim sFileName As String 

Dim sPath As String 

Dim firstpage As Long	

Dim iNumPages As Long 

Dim sDir As String

Dim sWildCard As String 

Dim POSTSCRIPT_LEVEL As Long 	



firstpage = 0

POSTSCRIPT_LEVEL = 2	



Set AcroApp = CreateObject("AcroExch.App")

’ Call AcroApp.show

Call AcroApp.hide	

Set AVDoc = CreateObject("AcroExch.AVDoc") 

Call AVDoc.Open(fname, "")                  '( sPath + sFileName, "" )

’ Call AVDoc.Open(fname, “pwd”) '( sPath + sFileName, “” )

Set PDDoc = AVDoc.GetPDDoc	

iNumPages = PDDoc.GetNumPages

’ Call AVDoc.PrintPages(firstpage, iNumPages - 1 , POSTSCRIPT_LEVEL, True, False )

Call AVDoc.PrintPagesSilent(firstpage, iNumPages - 1 , POSTSCRIPT_LEVEL, True, False )

Call AVDoc.Close( True )

'shut down all

Call AcroApp.Exit

Set AcroApp = Nothing	

Exit Sub

'err208: 'Cannot create automation object

’ Msgbox MSG_AutomationError + “Adobe”, 16, "Error " + Cstr(Err) + ": " + Error$

Print MSG_AutomationError + "Adobe"

'err213:

’ AttachmentsNotPrinted = AttachmentsNotPrinted + “” +Mid$(fname, 20, (Len(fname)-19)) + " - "

’ Exit Sub

AdobeErr:

AttachmentsNotPrinted = AttachmentsNotPrinted + "" +Mid$(fname, 20, (Len(fname)-19)) + " - "

Exit Sub

End Sub

Sub PrintTIF (fname As String)

Dim FileExtension As String

Dim Fn As String	

Dim Period As Integer

Dim Length As Integer



Length = Len(fname)

Period = Instr(1, fname, ".")

If Period = 0 Then 

	FileExtension = "" 

Else

	FileExtension = Mid$(fname, Period, 4)

End If

'change file extension to bmp

If FileExtension = ".tif" Then

'replace file extension to bmp

	Fn = Mid$(fname, 1, Length - 4)

	fname = Fn + ".bmp"

	Call PrintDefault (fname)

End If

End Sub

Sub PutStamp (session As NotesSession, dbBPI As NotesDatabase, doc As NotesDocument)

’ this program puts stamp on document after processed and move document to folder Completed

'Tasks

'Date and time Stamp

'Person printed this document

'Flag email document

'move to folder completed

'Required

'Folder named Completed	

Dim DateTime As NotesDateTime

Dim UserPrinted As String

Dim mailPrinted As String

Dim FolderName As String

Dim NewFolder As NotesView

Dim view As NotesView

Dim currentFolder As String

'get current folder name from Environment, this value set when Print action called from folder

currentFolder = session.GetEnvironmentString("FolderName")

’ Set view = dbBPI.GetView(“($Inbox)”)

If currentfolder <> "" Then

	Set view = dbBPI.GetView(currentFolder)

Else

	currentFolder = "($Inbox)"

	Set view = dbBPI.GetView("($Inbox)")	

End If	

FolderName = "Completed"

'if reqd to store region-wise after printing email

’ FolderName = currentFolder + " - Completed"

UserPrinted = session.commonusername	

Set dateTime = New NotesDateTime( "" )

Call datetime.setnow	

doc.PrintedbyUser = UserPrinted

doc.PrintedOn = datetime.LSLocalTime	

doc.mailPrinted = "Yes"

doc.regionname = currentfolder

Call doc.Save(True,False,True)

Call doc.PutInFolder(FolderName,True )

Print "current document moved to completed folder...."

’ Call doc.RemoveFromFolder(“($Inbox)”)

Call doc.RemoveFromFolder(currentFolder)

Print currentfolder

'Write log information if any attachments are not printed into log document

'when error write into log info - 06/21/2005

If AttachmentsNotPrinted <> "" Then

	Call writelog(AttachmentsNotPrinted)

End If

AttachmentsNotPrinted = ""

'refresh inbox and folder to show new documents

Set NewFolder = dbBPI.GetView(FolderName)

Call NewFolder.Refresh	

Call view.Refresh	

Exit Sub

End Sub

Sub writelog(AttachmentsNotPrinted As String)

Dim sess As New NotesSession

Dim logdoc As NotesDocument

Dim strName As NotesName

Dim fromname As String

fromname = doc.From(0)

Set logdoc = New NotesDocument ( dbBPI )

Set strName = New NotesName(fromname)	

logdoc.Form = "UW Log Form"

logdoc.Uw_From = strName.Common

logdoc.Uw_To = doc.To

logdoc.Uw_RegionName = doc.RegionName

logdoc.Uw_PrintedOn = doc.PRINTEDON

logdoc.Uw_PrintedBy= doc.PRINTEDBYUSER

’ logdoc.Uw_NoofAtt =

’ logdoc.Uw_AttPrinted = “New building”

logdoc.Uw_AttNotPrinted = Trim(AttachmentsNotPrinted)

logdoc.Uw_subject = doc.Subject	

Call logdoc.Save( True, True )

End Sub

Sub PrintZip(fname As String)

%REM

'To process zip file

'1. Copy WZUNZIP.EXE file to C:\Data\Notes\temp

'2. Create Zip directory under C:\Data\Notes\temp

create zipInzip folder under C:\Data\Notes\temp

'Correct from command prompt

'wzunzip “Claims data.zip” c:\data\notes\temp

%END REM

'UNZIP FILES FROM ZIP FILE AND DETACH TO C:\DATA\NOTES\TEMP\ZIP

Dim zip As Integer       

Dim shellCommand As String

Dim  ToDir As String, fromdir As String

Dim temp As String		

Dim s As New NotesSession



ToDir$ = " C:\\data\notes\temp\zip"

’ ToDir$ = " " + zipPath 'to handle zip in zip

'CREATING TEMP DIRECTORY PROCESS

'Directory is the Notes data Directory

%REM

ToDir = s.GetEnvironmentString ("Directory", True)

ToDir = ToDir & "\temp\zip"

If Dir$ (ToDir , 16)="" Then

	Mkdir ToDir

End If

ToDir = ToDir & "\"

%END REM

fromdir = "C:\\data\notes\temp\" &  fname

’ temp$ = Chr$(34) &Cstr(fromdir) & Chr$(34) 'this also works

temp$ = {"} & Cstr(fromdir) & |" |

’ shellCommand ="c:\data\notes\temp\wzunzip.exe " + temp$ + ToDir$

'added -o option for overwriting if files already extracted

shellCommand ="c:\\data\notes\temp\wzunzip.exe -o " + temp$ + ToDir$

zip% = Shell( shellCommand , 6)

’ Messagebox(“Files detached now by Shell”)

If zip% <> 33 Then

	Print "compression failed.."

’ Exit Sub

Else

'step -1 compression is successfull

'step -2 read directory where files detached

	Dim fileName As String, pathName As String, TDir As String

	TDir$ = s.GetEnvironmentString ("Directory", True)

’ TDir$ = TDir & “\temp\zip*.*”

	TDir$ = TDir & "\temp\zip"

’ directory$ = “C:\StreamFiles”

	Chdir TDir$                               'directory$

	fileName$ = Dir$("*.*")

’ Messagebox ("1. File name is " &filename$&TDir$)

	fileName$ = Dir$("*.*")   'recalling same function as first time not getting refreshed

’ Messagebox ("2. File name is " &filename$&TDir$)

’ pathName$ = TDir$ '“C:\data\notes\temp\zip*.*”

’ fileName$ = Dir$(pathName$, 0)

'When error write into log info - 07/01/2005

'Call writelog(doc, fname) there is something wrong in zip attachment process write to log file

	If fileName$ = "" Then			

		AttachmentsNotPrinted = AttachmentsNotPrinted + " " + fname

	End If	

	Do While fileName$ <> ""

		Messagebox ("File name is when fname is not blank " &filename$)

'now got the first file name process based on extension

'step - 3 one at a time and call print function

'step - 4 after all files printed delete detached files

		If fileName$ <> "" Then

			Print ("processing.......... "+fileName$)

’ Call ProcessZip("C:\data\notes\temp\zip" + fileName$,fileName$,fname) 'sending filename with path info

		End If

'Get the next filename and process

		fileName$ = Dir$()

		Loop  'Loops thru each file in the directory

	End If  'for fileName$ <> ""

'CALL CLEANUP CODE BEFORE PROCESSING NEW ZIP FILE

	Call CleanUp(fname)  'this process cleans c:\data\notes\temp\zip folder

End Sub

Sub ProcessZip(fileName As String, fnamenoPath As String, zipfname As String)

'here we get filename with path, fnamenoPath and Zip file name as param and get the extension

'then call corresponding sub Program to process

'after go back and get new filename and process so on…

'GET EXTENSION OF FILENAME FOR PRINT PROCESS

Dim Zfname As String

Dim ZPeriod As String

Dim ZFileExtension As String 

Dim Zret As Integer

Dim zipPath As String

'ON ERROR WRITE TO LOG FILE FILE NOT PRINTED

On Error Goto errHandle

'GET EXTENSION

Zfname = fileName                     'GetTmpDir + o.Source

ZPeriod = Instr(1, Zfname, ".")

If ZPeriod = 0 Then 

	ZFileExtension = "" 

Else

	ZFileExtension = Mid$(Zfname, ZPeriod, 4)

End If

'Handling two dots in a file name

Dim ZFileExt2 As String

ZFileExt2$ = Right$(Zfname, 4)

Print ZFileExt2$

'BASED ON EXTENSION CALL CORRESPONDING PRINT FUNCTION TO PRINT DOCUMENT

If Lcase$(ZFileExtension) = "" Then 	

	Print "No Extension or Census file" + Zfname

Elseif Lcase$(ZFileExtension) = ".doc" Or  Lcase$(ZFileExt2) = ".doc" Then