I am using this module along with that code . please try
Code:
' -------------------------------------------------------------------------
' Procedure : AddAttachmentsFromFolder
' Purpose : Adds one record to an attachment field for each file in the
' : specified folder.
' Arguments : strFolder - Name of the folder
' : strTable - Name of the table containing the attachment field
' : strField - Name of the attachment field
' : strPattern - Search pattern for the directory. Defaults to
' : all files (*.*)
' : fIncludeSubfolders - Include subfolders in the specified folder
' : Defaults to False
' Comments : This routine adds a new record to the table, then one attachment.
' : It commits the changes and handles all cleanup
' -------------------------------------------------------------------------
Sub AddAttachmentsFromFolder(ByVal strFolder As String, _
ByVal strTable As String, _
ByVal strField As String, _
Optional ByVal strPattern As String = "*.*", _
Optional ByVal fIncludeSubfolders As Boolean = False)
Dim strFile As String
Dim lngCount As Long
Dim rstParent As DAO.Recordset2
Dim rstChild As DAO.Recordset
Dim fldAttach As DAO.Field2
Dim objFso As Object ' Scripting.FileSystemObject
Dim objFolder As Object ' Scripting.Folder
Dim objFile As Object ' Scripting.File
Dim objSubFolder As Object ' Scripting.Folder
On Error GoTo ErrorHandler
' Instantiate the FileSystemObject
Set objFso = CreateObject("Scripting.FileSystemObject")
' fix up the folder
If (Right(strFolder, 1) <> "\") Then strFolder = strFolder & "\"
' make sure the folder exists
If (Dir(strFolder, vbDirectory) = "") Then
MsgBox "The specified folder does not exist: " & strFolder, vbExclamation
Exit Sub
End If
' get the folder object
Set objFolder = objFso.GetFolder(strFolder)
' open the table containing the attachment field
Set rstParent = CurrentDb().OpenRecordset(strTable)
' get the first file
strFile = Dir(strFolder & strPattern)
' get each file that meets the pattern
While (Len(strFile) > 0)
' add a record to the parent table
Debug.Print strFolder & strFile
rstParent.AddNew
' get the attachment recordset and FileData field to contain the file
Set rstChild = rstParent.Fields(strField).Value
Set fldAttach = rstChild.Fields("FileData")
' add the attachment to the attachment field
rstChild.AddNew
fldAttach.LoadFromFile strFolder & strFile
rstChild.Update
rstParent.Update
' get the next file
strFile = Dir
Wend
' recurse subfolders?
If (fIncludeSubfolders) Then
For Each objSubFolder In objFolder.SubFolders
AddAttachmentsFromFolder objSubFolder.Path, strTable, strField, _
strPattern, fIncludeSubfolders
Next
End If
Cleanup:
rstParent.close
Set rstParent = Nothing
Exit Sub
ErrorHandler:
Debug.Print "Error " & Err.Number & " - " & Err.Description
MsgBox Err.Description & vbCrLf & _
Err.Number & vbCrLf & _
Err.Source, VbMsgBoxStyle.vbCritical, "AddAttachmentsFromFolder Failed"
GoTo Cleanup
Thank you