Insert Multiple Files into a field

D

DoctorV3774

I have the following module which allows me to attach a file path into a
field of my form. This works fine if the field is null. However if the
field is already populated it will not let me add an additional file path for
an attachment. how can i modify this code so I can attach multiple files to
the field? Thanks



****************CODE****************

Function InsertNewFile()


Dim FileName As String
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Do you want to insert an attachment?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Warning" ' Define title.
Help = "DEMO.HLP" ' Define Help file.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
On Error GoTo err_showSendDialog
Dim CurrentAttach As String

If Response = vbYes Then ' User chose Yes.

'[Forms]![MyWorkspace]![LPID]

[Forms]![MyWorkspace]![EmailAttachment].Locked = False
FileName = FileToOpen()

If IsNull([Forms]![MyWorkspace]![EmailAttachment]) Then
CurrentAttach = ""
[Forms]![MyWorkspace]![EmailAttachment] = CurrentAttach & FileName

Else
CurrentAttach = [Forms]![MyWorkspace]![EmailAttachment] & "; " & FileName
MsgBox CurrentAttach
[Forms]![MyWorkspace]![EmailAttachment] = CurrentAttach

End If

[Forms]![MyWorkspace]![EmailAttachment].Locked = True


Else ' User chose No.
DoCmd.CancelEvent
exit_showSendDialog:
Exit Function
End If
err_showSendDialog:
If Err.Number = 2501 Then 'User Cancelled DoCmd
Resume exit_showSendDialog
Else 'Add your own error handling routine here
Resume exit_showSendDialog
Resume Next
End If

End Function
 
A

Alex Dybenko

Hi,
depends on your goal. for example you can separate file paths with
semicolon:
[Forms]![MyWorkspace]![EmailAttachment] =
[Forms]![MyWorkspace]![EmailAttachment] & ";" & CurrentAttach

also you can make a subtable - store path there, and show it as a list in
subform
 
D

DoctorV3774

Used this code with fso to add 2 files but not sure how to modify it for
adding 3 or more. Any ideas?

Function InsertNewFile()

Dim db As Database
Dim rs As Recordset
Dim Table As TableDef
Set db = CurrentDb
Dim fld, i As Integer
Dim FileName As String
Dim intLPID As Long
Dim ConcatAttach, rebuilt, dbAttach As String
Dim cFSO, nFSO As FileSystemObject
Dim cFile, nFile As File
Dim cPath, nPath As String


Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Do you want to insert an attachment?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Warning" ' Define title.
Help = "DEMO.HLP" ' Define Help file.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
On Error GoTo err_showSendDialog
Dim CurrentAttach As String


If Response = vbYes Then ' User chose Yes.

FileName = FileToOpen()
intLPID = ([Forms]![MyWorkspace]![LPID])
Set db = CurrentDb()
Set rs = db.OpenRecordset("Select Email_Attachment from LPINFO where LPID = "
& intLPID)

If Not rs.EOF Then
If Not IsNull(rs("Email_Attachment")) Then
dbAttach = rs("Email_Attachment")
Set cFSO = CreateObject("Scripting.FileSystemObject")
Set cFile = cFSO.GetFile(dbAttach)
cPath = cFile.path
Set nFSO = CreateObject("Scripting.FileSystemObject")
Set nFile = nFSO.GetFile(FileName)
nPath = nFile.path
Set cFile = Nothing
Set cFSO = Nothing
Set nFile = Nothing
Set nFSO = Nothing
End If
End If
Set rs = Nothing

[Forms]![MyWorkspace]![EmailAttachment].Locked = False


CurrentAttach = Nz(Forms!MyWorkspace!EmailAttachment, "")

If Len(CurrentAttach) = 0 Then
Forms!MyWorkspace!EmailAttachment = FileName
Else
Forms!MyWorkspace!EmailAttachment = cPath & "; " & nPath
End If
'Must refresh the form here
[Forms]![MyWorkspace].Refresh

'FileName = FileToOpen()




[Forms]![MyWorkspace]![EmailAttachment].Locked = True


Else ' User chose No.
DoCmd.CancelEvent
exit_showSendDialog:
Exit Function
End If
err_showSendDialog:
If Err.Number = 2501 Then 'User Cancelled DoCmd
Resume exit_showSendDialog
Else 'Add your own error handling routine here
Resume exit_showSendDialog
Resume Next
End If

End Function



Alex said:
Hi,
depends on your goal. for example you can separate file paths with
semicolon:
[Forms]![MyWorkspace]![EmailAttachment] =
[Forms]![MyWorkspace]![EmailAttachment] & ";" & CurrentAttach

also you can make a subtable - store path there, and show it as a list in
subform
I have the following module which allows me to attach a file path into a
field of my form. This works fine if the field is null. However if the
Click to expand...
[quoted text clipped - 56 lines]
End Function
Click to expand...
Click to expand...
 
A

Alex Dybenko

Dim cPath, nPath As String, nPath2 as string


then after this:
Set nFSO = CreateObject("Scripting.FileSystemObject")
Set nFile = nFSO.GetFile(FileName)
nPath = nFile.path

add:

Set nFile = nFSO.GetFile(FileName)
nPath2 = nFile.path

and replace this line:
Forms!MyWorkspace!EmailAttachment = cPath & "; " & nPath & "; " & nPath2


--
Alex Dybenko (MVP)
http://alexdyb.blogspot.com
http://www.PointLtd.com



DoctorV3774 said:
Used this code with fso to add 2 files but not sure how to modify it for
adding 3 or more. Any ideas?

Function InsertNewFile()

Dim db As Database
Dim rs As Recordset
Dim Table As TableDef
Set db = CurrentDb
Dim fld, i As Integer
Dim FileName As String
Dim intLPID As Long
Dim ConcatAttach, rebuilt, dbAttach As String
Dim cFSO, nFSO As FileSystemObject
Dim cFile, nFile As File
Dim cPath, nPath As String


Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Do you want to insert an attachment?" ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons.
Title = "Warning" ' Define title.
Help = "DEMO.HLP" ' Define Help file.
Ctxt = 1000 ' Define topic
' context.
' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
On Error GoTo err_showSendDialog
Dim CurrentAttach As String


If Response = vbYes Then ' User chose Yes.

FileName = FileToOpen()
intLPID = ([Forms]![MyWorkspace]![LPID])
Set db = CurrentDb()
Set rs = db.OpenRecordset("Select Email_Attachment from LPINFO where LPID
= "
& intLPID)

If Not rs.EOF Then
If Not IsNull(rs("Email_Attachment")) Then
dbAttach = rs("Email_Attachment")
Set cFSO = CreateObject("Scripting.FileSystemObject")
Set cFile = cFSO.GetFile(dbAttach)
cPath = cFile.path
Set nFSO = CreateObject("Scripting.FileSystemObject")
Set nFile = nFSO.GetFile(FileName)
nPath = nFile.path
Set cFile = Nothing
Set cFSO = Nothing
Set nFile = Nothing
Set nFSO = Nothing
End If
End If
Set rs = Nothing

[Forms]![MyWorkspace]![EmailAttachment].Locked = False


CurrentAttach = Nz(Forms!MyWorkspace!EmailAttachment, "")

If Len(CurrentAttach) = 0 Then
Forms!MyWorkspace!EmailAttachment = FileName
Else
Forms!MyWorkspace!EmailAttachment = cPath & "; " & nPath
End If
'Must refresh the form here
[Forms]![MyWorkspace].Refresh

'FileName = FileToOpen()




[Forms]![MyWorkspace]![EmailAttachment].Locked = True


Else ' User chose No.
DoCmd.CancelEvent
exit_showSendDialog:
Exit Function
End If
err_showSendDialog:
If Err.Number = 2501 Then 'User Cancelled DoCmd
Resume exit_showSendDialog
Else 'Add your own error handling routine here
Resume exit_showSendDialog
Resume Next
End If

End Function



Alex said:
Hi,
depends on your goal. for example you can separate file paths with
semicolon:
[Forms]![MyWorkspace]![EmailAttachment] =
[Forms]![MyWorkspace]![EmailAttachment] & ";" & CurrentAttach

also you can make a subtable - store path there, and show it as a list in
subform
I have the following module which allows me to attach a file path into a
field of my form. This works fine if the field is null. However if the
Click to expand...
[quoted text clipped - 56 lines]
End Function
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Access to Excel Automation Way over my head. 1
if then msgbox 1
Beep in a MsgBox 2
Checking the current date against a range of dates 6
URGENT!!! Problem with row data being truncated in a copy worksheet sub 1
add a .jpg to msg box 1
how to write VBA for DELETE RECORD? 3
Modified worksheet macro, where if Yes portion works but not else 4

Top