how to send attachments using path's instead of attachment field

S

sspreyer

Registered User.
Local time
Yesterday, 18:58
Joined
Nov 18, 2013
Messages
251
hi all

I have some code that attaches any files that are in my attachment field on the current record in to a email this is great but I m starting to realise that this is take up way to much space as it hold a copy in the database and can t afford to go down the sql sever route so what I have done is added some new fields called path1, path2 ,path3 ,path4 and path5 now the user can add the files location to these text box instead of add them via the attachment field also I can now limit number attachments to each record

now my problem, well I don't no where to start . I will start by posting the code I use at the moment

Code: 
Private Sub cmdEmail2_Click()
  Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim OutlookAttach As Outlook.Attachment
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
         Set appOutLook = New Outlook.Application
        Set ns = appOutLook.GetNamespace("MAPI")
        Dim folderOutlook As Folder
        Set folderOutlook = ns.GetDefaultFolder(olFolderInbox)
        folderOutlook.Display
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
Dim rsChild As DAO.Recordset2
 Dim strHTML
Set db = CurrentDb
Set rsParent = Me.Recordset
rsParent.OpenRecordset
Set rsChild = rsParent.Fields("Attachments").Value
While Not rsChild.EOF
If Dir("C:\Users\Shane\Documents\Reports for daz", vbDirectory) = "" Then
MkDir ("C:\Users\Shane\Documents\Reports for daz")
Else
'do nothing for the "C:\dbtemp" directory already exists
'MsgBox "C:\dbtemp\ directory already exists"
End If
rsChild.OpenRecordset
rsChild.Fields("Filedata").SaveToFile ("C:\Users\Shane\Documents\Reports for daz")
rsChild.MoveNext
Wend
 ' Build HTML for message body.
 'strHTML = "<HTML><HEAD>"
 'strHTML = "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>ID: </b></br>" & [ID] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Date: </b></br>" & [Date 1] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Address: </b></br>" & [Address] & "<br>" & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Works Description: </b></br>" & [Works Description] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Notes: </b></br>" & [Notes] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Comments.: </b></br>" & [Comments1] & "<br><br>"
 'strHTML = strHTML & "<FONT Face=Calibri><b>Notifiable: </b></br>" & [Notifiable] & "<br>"
 'strHTML = strHTML & "</FONT></br><BODY>"
'strHTML = strHTML & "<FONT Face=Arial Color=#ff0000 Size=5>Job #: 123456</FONT></br>"
'strHTML = strHTML & "<FONT Size=3>For: <FONT Size=2></B>a name here</br>"
'strHTML = strHTML & "<FONT Size=3><B>Description: </B><FONT Size=2>description of work to be done</FONT></br>"
 strHTML = strHTML & "</BODY></HTML>"
 With MailOutLook
.BodyFormat = olFormatRichText
'.To = "email address"
'.CC = " "
.Body = "Some text here"
.Subject = "test"
 .HTMLBody = strHTML
Dim fso As Object, SourceFolder As Object, SourceFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder("C:\Users\Shane\Documents\Reports for daz")
For Each SourceFile In SourceFolder.Files
.Attachments.Add SourceFolder.Path & "\" & SourceFile.Name
Next
.Display
'Send email
'.DeleteAfterSubmit = True 'This would let Outlook send the note without storing it in your sent bin
'.Send
On Error Resume Next
Kill "C:\Users\Shane\Documents\Reports for daz\*.*" ' delete all files in the folder
    On Error GoTo 0
'RmDir "C:\dbtemp\" ' delete folder
End With
 
End Sub
some how I need to change this so it checks fields path1 path2 path3 path4 path5 on the current record and see if anything is entered in these textbox's and follow the paths and attach the files to email


very very grateful!! for any help with this as my database is grow fast worry about the 2g limit


also I would like to share some code to help others as this forum has help me get better and better at programing as when I start just about new how to make command button


how to add a file path to a text box

1. add new field to your table e.g "path1"
2. add the new field to your form
3 create new command button call it addpath
4 add code below to click on event

Code: 
Private Sub addpath_Click()
  Dim fDialog As Office.FileDialog
   Dim varFile As Variant
    ' Clear listbox contents. '
   Me.Path1.Value = ""
    ' Set up the File Dialog. '
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fDialog
       ' Allow user to make multiple selections in dialog box '
      .AllowMultiSelect = False
       ' Set the title of the dialog box. '
      .Title = "Please select one file"
       ' Clear out the current filters, and add our own.'
      .Filters.Clear
    
      .Filters.Add "All Files", "*.*"
       ' Show the dialog box. If the .Show method returns True, the '
      ' user picked at least one file. If the .Show method returns '
      ' False, the user clicked Cancel. '
      If .Show = True Then
      'add selected path to text box
     Me.Path1.Value = .SelectedItems(1)
       Else
         MsgBox "You clicked Cancel in the file dialog box."
      End If
   End With
End Sub
this will now save file location path to the path1 text box


To open file path
1.add another command button call it "pathopen"
2. add code below on click event

Code: 
Private Sub pathopen_Click()
Application.FollowHyperlink Me.Path1
End Sub
I'm certainly no great programmer but I hope this will help someone like everyone here that help me


thanks in advance

shane
 
Last edited:
some how I need to change this so it checks fields path1 path2 path3 path4 path5 on the current record and see if anything is entered in these textbox's and follow the paths and attach the files to email
Click to expand...
For this could you not use something along the lines of
Code: 
If Not IsNull(rsParent.Field1) Then
With MailOutlook
.attachments.add 'field1' 'filename' ' or whatever the actual code is
EndWith
end if
If Not IsNull(rsparent.Field2) Then
With Mailoutlook
.attachments.add etc etc etc
endwith
end if
etc for each field?
Afaik make sure you end with before your next If or you'll get some If errors popping up (something I found out last week after some struggling!!)

I hope this helps you on the right path, goodluck!
 
thanks mh123 got working a treat legend !!

my code for any one else who struggling
Code: 
 Private Sub cmdEmail2_Click()
  Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Dim OutlookAttach As Outlook.Attachment
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
         Set appOutLook = New Outlook.Application
        Set ns = appOutLook.GetNamespace("MAPI")
        Dim folderOutlook As Folder
        Set folderOutlook = ns.GetDefaultFolder(olFolderInbox)
        folderOutlook.Display
Dim db As DAO.Database
Dim rsParent As DAO.Recordset2
 Dim strHTML
Set db = CurrentDb
Set rsParent = Me.Recordset
rsParent.OpenRecordset
  strHTML = strHTML & "<FONT Face=Calibri><b>ID: </b></br>" & [ID] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Date: </b></br>" & [Date 1] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Address: </b></br>" & [Address] & "<br>" & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Works Description: </b></br>" & [Works Description] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Notes: </b></br>" & [Notes] & "<br>"
 strHTML = strHTML & "<FONT Face=Calibri><b>Comments.: </b></br>" & [Comments1] & "<br><br>"
 'strHTML = strHTML & "<FONT Face=Calibri><b>Notifiable: </b></br>" & [Notifiable] & "<br>"
 'strHTML = strHTML & "</FONT></br><BODY>"
'strHTML = strHTML & "<FONT Face=Arial Color=#ff0000 Size=5>Job #: 123456</FONT></br>"
'strHTML = strHTML & "<FONT Size=3>For: <FONT Size=2></B>a name here</br>"
'strHTML = strHTML & "<FONT Size=3><B>Description: </B><FONT Size=2>description of work to be done</FONT></br>"
 strHTML = strHTML & "</BODY></HTML>"
 With MailOutLook
If Not IsNull(rsParent.Path1) Then
With MailOutLook
.Attachments.Add (Path1) ' 'filename' ' or whatever the actual code is
End With
End If
If Not IsNull(rsParent.Path2) Then
With MailOutLook
.Attachments.Add (Path2)
End With
End If
If Not IsNull(rsParent.Path3) Then
With MailOutLook
.Attachments.Add (Path3)
End With
End If
If Not IsNull(rsParent.Path4) Then
With MailOutLook
.Attachments.Add (Path4)
End With
End If
If Not IsNull(rsParent.Path5) Then
With MailOutLook
.Attachments.Add (Path5)
End With
End If
 .BodyFormat = olFormatRichText
'.To = "email address"
'.CC = " "
.Body = "Some text here"
.Subject = "test"
 .HTMLBody = strHTML
 .Display
'Send email
'.DeleteAfterSubmit = True 'This would let Outlook send the note without storing it in your sent bin
'.Send
On Error Resume Next
     On Error GoTo 0
 End With
 
End Sub
cheers

shane
 
You must log in or register to reply here.

Similar threads

B
DoCmd.RunCommand acCmdPaste stopped working, think office 365 update
Replies
3
Views
211
bignose2
B
M
Signature Image in GMail email body
Replies
6
Views
231
xavier.batlle
X
Papashep
Solved Access vba Manage an Attachment field with vba
Replies
8
Views
1,047
Pat Hartman
P
J
Save Email to Directory
2 3
Replies
58
Views
3,435
johankotze
J
A
how to insert attachment in sharepoint list using ado access vba
Replies
3
Views
574
theDBguy
theDBguy

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom