Here's a code for extracting attachments/files from documents in LN web application:
Sub Initialize
On Error Goto errhandle
Dim session As New NotesSession
Dim db As notesdatabase
Dim view As NotesView
Dim doc As NotesDocument
        
Dim object As NotesEmbeddedObject
        
Dim collection As NotesDocumentCollection
Dim currentResponse As NotesDocument
        
Dim tempDirectory, actualDir As String
Dim nameAtt, result As Variant
Dim numAtt, count As Integer
        
tempDirectory="P:\\Gayatri\\Temp\\"
' tempDirectory="O:\\CITC\\ECAS\\GRCE\\"
Set db = session.CurrentDatabase
Set view = db.GetView("KBByCategory1")
        
numAtt = 0
count=0
cnt = 0
        
Dim myNames() As String
        
Set doc = view.GetFirstDocument
        
While Not (doc Is Nothing)
                
result = Evaluate("@Attachments", doc)
nameAtt = Evaluate("@AttachmentNames", doc)
numAtt = result(0)
                
If numAtt > 0 Then
For i=0 To numAtt-1 Step 1
If nameAtt(0) <> "" Then
Set object = doc.GetAttachment( nameAtt( i ) )
indx = 0
flag = "no"
For k = 1 To cnt Step 1
If nameAtt( i ) = myNames( k ) Then
indx = indx + 1
flag = "yes"
End If
Next
If flag = "yes" Then
filename = Left$(nameAtt( i ),Len(nameAtt( i ))-4) + "_" + indx + Right$(nameAtt( i ), 4)
Else
filename = nameAtt( i )
End If
                                        
actualDir = tempDirectory & filename
Call object.ExtractFile(actualDir)
count = count + 1
                                        
End If
Next
End If
                
If numAtt > 0 Then
Redim Preserve myNames(cnt+numAtt)
For j = 1 To numAtt
myNames(cnt + j) = nameAtt( j - 1 )
Next
cnt = cnt + numAtt
End If
                
'------------------------------- Response ------------------
Set collection = doc.Responses
Set currentResponse = collection.GetFirstDocument
                
While Not ( currentResponse Is Nothing )
                        
result = Evaluate("@Attachments", currentResponse)
nameAtt = Evaluate("@AttachmentNames", currentResponse)
numAtt = result(0)
                        
If numAtt > 0 Then
For i=0 To numAtt-1 Step 1
If nameAtt(0) <> "" Then
                                                
Set object = currentResponse.GetAttachment( nameAtt( i ) )
indx = 0
flag = "no"
For k = 1 To cnt Step 1
If nameAtt( i ) = myNames( k ) Then
indx = indx + 1
flag = "yes"
End If
Next
If flag = "yes" Then
filename = Left$(nameAtt( i ),Len(nameAtt( i ))-4) + "_" + indx + Right$(nameAtt( i ), 4)
Else
filename = nameAtt( i )
End If
                                                
actualDir = tempDirectory & "Responses\\" & filename
Call object.ExtractFile(actualDir)
count = count + 1
End If
Next
End If
                        
If numAtt > 0 Then
Redim Preserve myNames(cnt+numAtt)
For j = 1 To numAtt
myNames(cnt + j) = nameAtt( j - 1 )
Next
cnt = cnt + numAtt
End If
                        
Set currentResponse = collection.GetNextDocument( currentResponse )
                        
Wend
                
Set doc = view.GetNextDocument (doc)
                
Wend
Msgbox cnt
For i = 1 To 21 Step 1
Msgbox myNames(i)
Next
Msgbox count
Exit Sub
errhandle:
Messagebox " Error line: " & Erl() & " error : " & Err() & " err() : " & Err()
End Sub
Sub Initialize
On Error Goto errhandle
Dim session As New NotesSession
Dim db As notesdatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim object As NotesEmbeddedObject
Dim collection As NotesDocumentCollection
Dim currentResponse As NotesDocument
Dim tempDirectory, actualDir As String
Dim nameAtt, result As Variant
Dim numAtt, count As Integer
tempDirectory="P:\\Gayatri\\Temp\\"
' tempDirectory="O:\\CITC\\ECAS\\GRCE\\"
Set db = session.CurrentDatabase
Set view = db.GetView("KBByCategory1")
numAtt = 0
count=0
cnt = 0
Dim myNames() As String
Set doc = view.GetFirstDocument
While Not (doc Is Nothing)
result = Evaluate("@Attachments", doc)
nameAtt = Evaluate("@AttachmentNames", doc)
numAtt = result(0)
If numAtt > 0 Then
For i=0 To numAtt-1 Step 1
If nameAtt(0) <> "" Then
Set object = doc.GetAttachment( nameAtt( i ) )
indx = 0
flag = "no"
For k = 1 To cnt Step 1
If nameAtt( i ) = myNames( k ) Then
indx = indx + 1
flag = "yes"
End If
Next
If flag = "yes" Then
filename = Left$(nameAtt( i ),Len(nameAtt( i ))-4) + "_" + indx + Right$(nameAtt( i ), 4)
Else
filename = nameAtt( i )
End If
actualDir = tempDirectory & filename
Call object.ExtractFile(actualDir)
count = count + 1
End If
Next
End If
If numAtt > 0 Then
Redim Preserve myNames(cnt+numAtt)
For j = 1 To numAtt
myNames(cnt + j) = nameAtt( j - 1 )
Next
cnt = cnt + numAtt
End If
'------------------------------- Response ------------------
Set collection = doc.Responses
Set currentResponse = collection.GetFirstDocument
While Not ( currentResponse Is Nothing )
result = Evaluate("@Attachments", currentResponse)
nameAtt = Evaluate("@AttachmentNames", currentResponse)
numAtt = result(0)
If numAtt > 0 Then
For i=0 To numAtt-1 Step 1
If nameAtt(0) <> "" Then
Set object = currentResponse.GetAttachment( nameAtt( i ) )
indx = 0
flag = "no"
For k = 1 To cnt Step 1
If nameAtt( i ) = myNames( k ) Then
indx = indx + 1
flag = "yes"
End If
Next
If flag = "yes" Then
filename = Left$(nameAtt( i ),Len(nameAtt( i ))-4) + "_" + indx + Right$(nameAtt( i ), 4)
Else
filename = nameAtt( i )
End If
actualDir = tempDirectory & "Responses\\" & filename
Call object.ExtractFile(actualDir)
count = count + 1
End If
Next
End If
If numAtt > 0 Then
Redim Preserve myNames(cnt+numAtt)
For j = 1 To numAtt
myNames(cnt + j) = nameAtt( j - 1 )
Next
cnt = cnt + numAtt
End If
Set currentResponse = collection.GetNextDocument( currentResponse )
Wend
Set doc = view.GetNextDocument (doc)
Wend
Msgbox cnt
For i = 1 To 21 Step 1
Msgbox myNames(i)
Next
Msgbox count
Exit Sub
errhandle:
Messagebox " Error line: " & Erl() & " error : " & Err() & " err() : " & Err()
End Sub
 
 
No comments:
Post a Comment