Automatically reattach after modification of an attachment - Part II

This script gives your databases the functionality to detach / edit / attach an attachment with one single click. Part II

This is Part II of script that gives your databases the functionality to detach // edit // attach an attachment with one single click.
Here is a downloadable sample database.
Click here for part one
'==========================================================================================

 Class ArraySets Public Value ( ) As String Public TotalElements As Integer Sub Init TotalElements = 0 Redim Value ( 1 To 1 ) As String End Sub Sub AddElement ( NewValue As String ) TotalElements = TotalElements + 1 Redim Preserve Value ( 1 To TotalElements ) As String Value ( TotalElements ) = NewValue End Sub Function Search ( SearchFor As String ) As Integer Dim CurrentLabelEntry As Integer CurrentLabelEntry = 1 Forall c In Value If Ucase ( c ) = Ucase (SearchFor ) Then Exit Forall CurrentLabelEntry = CurrentLabelEntry + 1 End Forall Search = CurrentLabelEntry End Function End Class '========================================================================================== Class Attachment Private ExtractTo As String Private FilesToExtract As String Private LastModificationTime As String '// PUBLIC FUNCTIONS AND SUBS Declare Public Sub New ( wDirectory As String ) Declare Public Sub DetachAndEdit ( AttName As String , InItem As String ) Declare Public Sub Modify ( InItem As String ) Declare Public Sub RemoveByName ( ObjName As String , InItem As String ) Declare Public Sub Attach ( FileName As String , InItem As String ) Declare Public Function SelectAttachment ( InItem As String ) As String Declare Public Function IsModified ( AttName As String ) As Variant '// PRIVATE FUNCTIONS AND SUBS Declare Private Function ExistFileDirDrive ( FilePathName As String ) As Integer Declare Private Function FindExecutableByExtension ( FullPath As String ) As Variant Declare Private Function GetNthAttachment ( InItem As String , Position As Integer ) As Variant Declare Private Function GetAttachmentByName ( InItem As String , AttName As String ) As Variant Declare Private Function DetachByName ( InItem As String , AttName As String , path As String , overwrite As Integer ) As Variant Declare Private Function Count ( InItem As String ) As Integer Declare Private Function ExtractFileName( FilePath As String ) As String Declare Private Function IsDriveAvailable ( drivNam$ ) As Variant Declare Private Function IsPathAvailable ( path As String ) As Variant Declare Private Function FileLastModified ( strPath As String ) As String Declare Private Function GetRegValue ( hKey As Long , strPath As String , strValue As String ) As String Declare Private Function GetMSWord () As String Declare Private Function GetMSExcel () As String Declare Private Function GetMSProject98 () As String Declare Private Function IsWin2000 () As Variant Declare Private Sub ShellAndWait ( Byval RunProg As String ) Declare Private Function GetShortFileName ( fileName As String ) As String '// added 08/24/2000 Declare Private Function IsAvailable ( FileName As String ) As Variant Declare Private Function sWord ( sourceString As String, separator As String, number As Integer ) As String Declare Private Function PopMenu (pstrItem As String, mx As Long, my As Long) As Long '// PROPERTIES Declare Public Property Get WorkDir As String Declare Public Property Set WorkDir As String Public Sub New ( ExtractFilesTo As String ) dummy = IsPathAvailable(ExtractFilesTo) ExtractTo = ExtractFilesTo End Sub Public Property Get WorkDir As String WorkDir = ExtractTo End Property Public Property Set WorkDir As String dummy = IsPathAvailable( WorkDir ) ExtractTo = WorkDir End Property Private Function GetRegValue ( hKey As Long , strPath As String , strValue As String ) As String '// Retrieves a value from the Windows registry '// Called by : Method '// Calls : none Dim hCurKey As Long Dim lResult As Long Dim lValueType As Long Dim strBuffer As String Dim lDataBufferSize As Long Dim intZeroPos As Integer Dim lRegResult As Long GetSettingString = "" lRegResult = RegOpenKey(hKey, strPath, hCurKey) lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, Byval 0&, lDataBufferSize) If lRegResult = ERROR_SUCCESS Then If lValueType = REG_SZ Then strBuffer = String(lDataBufferSize, " ") lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, Byval strBuffer, lDataBufferSize) intZeroPos = Instr(strBuffer, Chr$(0)) If intZeroPos > 0 Then GetRegValue = Left$(strBuffer, intZeroPos - 1) Else GetRegValue = strBuffer End If End If Else End If lRegResult = RegCloseKey(hCurKey) End Function Private Function GetMSWord () As String GetMSWord = Cstr ( GetRegValue ( HKEY_LOCAL_MACHINE , WINWORD , "" ) ) End Function Private Function GetMSExcel () As String GetMSExcel = Cstr ( GetRegValue ( HKEY_LOCAL_MACHINE , EXCEL , "" ) ) End Function Private Function GetMSProject98 () As String GetMSProject98 = Cstr ( GetRegValue ( HKEY_LOCAL_MACHINE , PROJEKT , "" ) ) End Function Private Function IsWin2000 () As Variant If Cstr ( GetRegValue ( HKEY_LOCAL_MACHINE , WIN_VERSION , WIN_VERSION_KEY ) ) = "Microsoft Windows 2000" Then IsWin2000 = True Else IsWin2000 = False End If End Function Automatically reattach after modification of an attachment - Part Three Click here for part one: Click here for part two: Public Sub DetachAndEdit (AttName As String , InItem As String ) '// Detach a file from a specified Item and edit the file in the associated application '// Called by : Method '// Calls : Function FindExecutableByExtension, GetShortFileName, ShellAndWait TempPath$ = Left ( WorkDir , ( Len ( WorkDir ) - 1 ) ) dummy& = DetachByName ( InItem , AttName , TempPath$ , 1 ) '// detach the file to the WorkDirectory LastModificationTime = FileLastModified ( AttName ) '// Read the File's LastModifiedDate and store it for further use FullPath$ = TempPath$ & "" & AttName If ( Ucase ( Right$ ( AttName , 3 ) ) = "MPP" ) Then '// added 08/24/2000 ExeFile = GetMSProject98 & " " '// Executable is not returned by API, use Registry settings Else If IsWin2000 And ( Ucase ( Right$ ( AttName , 3 ) ) = "DOC" ) Then ExeFile = GetMSWord & " " Else If IsWin2000 And ( Ucase ( Right$ ( AttName , 3 ) ) = "XLS" ) Then ExeFile = GetMSExcel & " " Else ExeFile = FindExecutableByExtension ( FullPath$ ) & " " '// Find the executable for the detached file End If End If End If ShellAndWait ( Cstr ( ExeFile ) & GetShortFileName ( FullPath$ ) ) '// Launch the file with the associated application End Sub Public Sub Modify ( InItem As String ) 'Public Sub Modify (AttName As String , InItem As String ) '// Does all in one: Detach, Edit adn Re-Attach an Attachment in the specified RT-Item '// Called by : Method '// Calls : Function FindExecutableByExtension, GetShortFileName , ShellAndWait Dim AttName As String AttName = SelectAttachment ( InItem ) If AttName = "" Then Exit Sub Else Dim session As New NotesSession Dim workspace As New NotesUIWorkspace Dim intOK As Integer intOK = -1 'if DialogBox is not displayed, then proceed with Shell and Edit anyway If Not(session.GetEnvironmentString("EDMShowAttachDialog") = "NO") Then 'Note "NoNewFields=True" parameter so no amendments are made to current document: see Dialog's QueryClose event for setting of EDMShowAttachDialog parameter intOK = workspace.DialogBox("(fDialogReAttachInfo)",True, True, False, False, True, False, "Confirm editing with Auto Re-Attach: " & strSelectedAttachment ) End If If intOK = -1 Then 'go ahead and actually Shell out and Edit the selected attachment. TempPath$ = Left ( WorkDir , ( Len ( WorkDir ) - 1 ) ) dummy& = DetachByName ( InItem , AttName , TempPath$ , 1 ) '// detach the file to the WorkDirectory LastModificationTime = FileLastModified ( AttName ) '// Read the File's LastModifiedDate and store it for further use FullPath$ = TempPath$ & "" & AttName If ( Ucase ( Right$ ( AttName , 3 ) ) = "MPP" ) Then '// added 08/24/2000 ExeFile = GetMSProject98 & " " '// Executable is not returned by API, use registry settings Else If IsWin2000 And ( Ucase ( Right$ ( AttName , 3 ) ) = "DOC" ) Then ExeFile = GetMSWord & " " Else If IsWin2000 And ( Ucase ( Right$ ( AttName , 3 ) ) = "XLS" ) Then ExeFile = GetMSExcel & " " Else ExeFile = FindExecutableByExtension ( FullPath$ ) & " " '// Find the executable for the detached file End If End If End If ShellAndWait ( Cstr ( ExeFile ) & GetShortFileName ( FullPath$ ) ) '// Launch the file with the associated application If IsModified ( AttName ) Then '// only if the attachment has been modified Call RemoveByName ( AttName , InItem ) Call Attach ( AttName , InItem ) End If Kill FullPath$ End If End If End Sub

End of Part II
Click here for Part III
Click here for Part I

This was first published in February 2002

Dig deeper on Domino Resources - Part 3

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchEnterpriseLinux

SearchDataCenter

SearchExchange

SearchContentManagement

Close