I'm trying to figure out if there's a way to add an attachment to
a database?
I have a database that's been created for submitting work
requests to a
workgroup. The input form includes customer data, order
information, etc. With some requests, the receiving group needs a
copy of a specific form from the person inputting the request.
I'm trying to find a way for them to attach the document to the
request in Access to prevent them from having to remember to
e-mail the form to the team.
Is this possible?
Thanks.
Todd
There are two routes to follow, one is to embed the file in an ole
object field (not reccomended for lots of reasons but easy), us a
hyperlink field to simply point to the file, or copy the file to a
subdirectory on the file server, renaming it to e.g
WorkRequest0001Attachment007, and storing the new name in a table
for attachments in the database. (This is the best way)
The following code would go behind buttons to Add a new attachment
and Show the existing attachment. Table structure can be deduced
from the code.
Private Sub CmdAddAttachment_Click()
Dim strNewFile As String
Dim strFileToGet As String
Dim strFiletype As String
Dim lngNextSeqNo As Long
Dim strFilter As String
Dim strBasePath As String
Dim strSQL As String
Dim strDescription As String
strBasePath = "C:\WorkOrderDB\attachments\"
strFileToGet = AttachFile
strFilter = Me.Filter
lngNextSeqNo = Nz(DMax("attachmentID", "Attachments", _
"WorkOrderID = " & Forms!WorkOrders!WorkOrderID), 0) + 1
If Len(strFileToGet) > 0 Then
strFiletype = getFileExtension(strFileToGet)
strNewFile = _
Format(Val(Nz(Forms!WorkOrders!WorkOrderID, 9999)), "0000")
_
& "_" _
& Format(lngNextSeqNo, "000") _
& "." & strFiletype
FileCopy strFileToGet, strBasePath & strNewFile
Me.AllowAdditions = True
With Me.Recordset
.AddNew
!WorkOrderID = Me.OpenArgs
!AttachmentID = lngNextSeqNo
!Filename = strNewFile
!Description = "Copy OF " & strFileToGet
!AttachedBy = Environ("username")
!DateAttached = Now()
.Update
End With
Me.AllowAdditions = False
End If
End Sub
Private Sub cmdViewAttachment_Click()
Dim strBasePath
strBasePath = DLookup("Path", "attachmentPath")
fHandleFile strBasePath & Me!Filename, 1
End Sub
Private Sub Command13_Click()
On Error GoTo Err_Command13_Click
DoCmd.Close
Exit_Command13_Click:
Exit Sub
Err_Command13_Click:
MsgBox Err.Description
Resume Exit_Command13_Click
End Sub
Private Function getFileExtension(Filename As String) As String
Dim iPointer As Integer
Dim stCurChar As String
For iPointer = Len(Filename) To 2 Step -1
stCurChar = Mid(Filename, iPointer, 1)
Select Case stCurChar
Case "\"
getFileExtension = ""
Exit For
Case "."
Exit For
Case Else
getFileExtension = stCurChar & getFileExtension
End Select
Next iPointer
If Len(getFileExtension) > 5 Then
getFileExtension = "tbd"
End If
End Function
