Enterprise Integration Forum : Solution: Adding attachment to Notes From SQL Server

The following code snippet is the solution for the problem "Adding attachment to Notes From SQL Server"

Sub Initialize

Set LCSessionSQL = New LCSession
Set ConnSQL = New LCConnection("oledb")
Set ConnFiles = New LCConnection("file")

Set Session = New NotesSession
Set dbCurrent = session.CurrentDatabase

Dim doc As NotesDocument
Dim rtItem As NotesRichTextItem

Dim FldList As New LCFieldList
Dim FldListAttach As New LCFieldList
Dim FldListFiles As New LCFieldList
Dim FldFileName As LCField

Dim StrSQL As String
Dim StrFileName As String

On Error Goto ErrorHandler

StrSQL="SELECT file_name, file_data FROM attachment_tbl"

If DBConnect() = False Then
Exit Sub
End If

If FileConnect() = False Then
Exit Sub
End If

Call ConnFiles.Select(Nothing, 1, FldListFiles)

If (ConnSQL.Execute(StrSQL, FldList) = 0) Then
Msgbox "No records were found"
ConnSQL.Disconnect
Exit Sub
End If

If FldList.RecordCount = 0 Then
Msgbox "No records were found"
ConnSQL.Disconnect
Exit Sub
End If

Set FldFileName = FldListFiles.Lookup("Filename")
Call FldListAttach.MapName(FldListFiles,"Filename,Contents", "file_name, file_data")

While (ConnSQL.Fetch(FldListAttach))>0
Call ConnFiles.Insert(FldListFiles)

StrFileName = TempPath & StrUniqueFolder & "/" & FldFileName.Value(0)

'TempPath holds the Windows temporary path or your hardcoded temp path (eg) c:\temp\

Set doc = dbCurrent.CreateDocument
doc.Form = "Spike"
doc.AttachFileName = FldFileName.Value(0)
Set rtItem = doc.CreateRichTextItem("Body")
Call rtItem.EmbedObject ( EMBED_ATTACHMENT, "", StrFileName)

Call doc.Save(True,True)

Kill StrFileName
Wend

ConnSQL.Disconnect
ConnFiles.Disconnect
Exit Sub
ErrorHandler:
Msgbox "Error" & Str(Err) & ": " & Error$
If Not (ConnSQL Is Nothing) Then
ConnSQL.Disconnect
End If
If Not (ConnFiles Is Nothing) Then
ConnFiles.Disconnect
End If
Exit Sub
End Sub

Function DBConnect() As Boolean

On Error Goto ErrorHandler

ConnSQL.Provider = "SQLOLEDB"
ConnSQL.Init_Datasource = "" ' SERVER NAME
ConnSQL.Database = "" ' DATABASE NAME
ConnSQL.Userid = "" ' USER ID
ConnSQL.Password = "" ' PASSWORD
ConnSQL.Connect
DBConnect=True
Exit Function
ErrorHandler:
DBConnect=False
Exit Function
End Function

Function FileConnect() As Boolean
On Error Goto ErrorHandler

Dim StrWinGetTempPath As String
Dim StrFullPath As String
Dim nLength As Integer
Dim varTemp As Variant

StrWinGetTempPath = TempPath 'Windows temporary path or your hardcoded temp path
nLength = Len(Trim(StrWinGetTempPath))
StrWinGetTempPath = Left(Trim(StrWinGetTempPath),nLength-1)

varTemp = Evaluate("@Unique")
StrUniqueFolder = varTemp(0)
StrFullPath = TempPath & StrUniqueFolder
Mkdir StrFullPath

ConnFiles.Database = StrWinGetTempPath
ConnFiles.Metadata = StrUniqueFolder
ConnFiles.Binary = True
ConnFiles.Connect
FileConnect=True
Exit Function
ErrorHandler:
FileConnect=False
Exit Function
End Function

Enterprise Integration Forum

Resources

Lotus Support

Wikis

Lotus Forums