iv been pulling my hair out over this ill explain what were doing at the momemnt we get a fax with the details of work done on a site ( yes we know its not the 1980 but fax is easy) we then enter the data into access 2010 and in this database we want to add a button to email the user but we want a copy of the fax to go with it the fax arrives as a number of jpeg files so i used Application.FileDialog(3) to make it prompt no problem there. but it will not attach i cant get the input out of it iv tryed using selected items but no luck the code is posted below if someone could take a look and let me know if im doing something silly
Private Sub Command576_Click()
' on any error show a message
Dim messageone
' skip the error message if its working
Dim skiperror
'call items from form on screen
BRANCHNAME = Me!BRANCHNAME
BranchManager = Me![Person Called]
emailprompt = Me![Branch Manager 1 - Email Address]
arrivetime = Me![optimal time of arrival]
deploydate = Me![Attending Date]
Counterpos = Me![Counter Positions]
Foffice = Me![Front Office]
Boffice = Me![back office]
TAU = Me![TAU Present]
Camilla = Me![Camilla Present]
bid = Me![Branch ID]
'contents of the body of the message
partone = "<font face = calibri> <span style='color:#1F497D'> Dear" & " " & BranchManager & vbCrLf & "<p> Thank you for your time on the phone.</p> <p> To confirm the details of our conversation, we will be attending your branch" & " " & "on" & " " & deploydate & "." & " " & "As discussed your Ops Specialist will be available to assist in the deployment of new counter terminals and is familiar with the instructions attached to this email.</p>" & vbCrLf & "<p>We will expect</p><p>" & vbCrLf & Counterpos & " " & "Counter Devices</p><p>" & vbCrLf & Foffice & " " & "Front Office Devices</p><p>" & vbCrLf & Boffice & " " & "Back Office Devices</p><p>" & vbCrLf & TAU & " " & "Devices connected to Teller Assist Units</P><p>" & vbCrLf & Camilla & " " & "Devices connected to Camilla units</P>" & vbCrLf & "<p>We will be replacing the computers in all positions <strong> apart from the POD workstation and any unused machines.</strong></p>"
parttwo = "Existing monitors will remain in place, as will keyboards on counter positions. For all non-counter positions we will provide a new keyboard and mouse." & vbCrLf & "<p>The impact to your branch should be minimal. Please expect it to take 10 - 15 minutes to deploy each non-counter position.</P><p> Counter positions will take longer as your Ops Specialist will be required to balance and transfer the funds from the till and return them once the new device is in place. We estimate this process will take 15-30 minutes.</font> </P>"
'
sig1 = "<p><font face = calibri> <size=10> NAME<br>"
sig2 = "<font face = calibri> <size=8>MDS Project Manager<br>"
sig3 = "<font face = calibri><size=10> Dell | Infrastructure Managed Services<br>"
sig4 = "<font face = calibri> <size=8>0141 202 5748<br>"
sig5 = "<font face = calibri> <size=8>EMAIL</p>"
'Open an instance of microsoft outlook, name it olk.
Dim olk As Outlook.Application
Set olk = CreateObject("Outlook.application")
'Create a new, empty outlook e-mail message
Dim olkMsg As Outlook.MailItem
Set olkMsg = olk.CreateItem(olMailItem)
'Put data from form into the new message
With olkMsg
Dim FILES As Office.FileDialog
Set FILES = Application.FileDialog(3)
FILES.AllowMultiSelect = True
' Show the dialog. If the method returns True, the user picked at least one file.
' If the method returns False, the user clicked Cancel.
If FILES.Show Then
MsgBox FILES.SelectedItems.Count & " file(s) were chosen."
' Display the full path to each file that was selected
Dim i As Integer
For i = 1 To FILES.SelectedItems.Count
MsgBox FILES.SelectedItems(i)
Next i
End If
Dim sPathAndFilename As Variant
Dim objOutlookAttach As Outlook.Attachment
Dim AttachME As Variant
FILES.SelectedItems = AttachME
Dim OlkRecip As Outlook.Recipient
.SentOnBehalfOfName = ("EMail")
Set OlkRecip = .Recipients.Add(emailprompt)
OlkRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("EMAil")
objOutlookRecip.Type = olCC
.Subject = "Site Visit" & " " & BRANCHNAME & " " & bid
.HTMLBody = partone & parttwo & sig1 & sig2 & sig3 & sig4 & sig5
For Each AttachME In .SelectedItems
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments
End If
Next AttachME
.Send
End With
Set olk = Nothing
Set olkMsg = Nothing
Set OlkRecip = Nothing
' stop it displaying the error when its working
End Sub
Private Sub Command576_Click()
' on any error show a message
Dim messageone
' skip the error message if its working
Dim skiperror
'call items from form on screen
BRANCHNAME = Me!BRANCHNAME
BranchManager = Me![Person Called]
emailprompt = Me![Branch Manager 1 - Email Address]
arrivetime = Me![optimal time of arrival]
deploydate = Me![Attending Date]
Counterpos = Me![Counter Positions]
Foffice = Me![Front Office]
Boffice = Me![back office]
TAU = Me![TAU Present]
Camilla = Me![Camilla Present]
bid = Me![Branch ID]
'contents of the body of the message
partone = "<font face = calibri> <span style='color:#1F497D'> Dear" & " " & BranchManager & vbCrLf & "<p> Thank you for your time on the phone.</p> <p> To confirm the details of our conversation, we will be attending your branch" & " " & "on" & " " & deploydate & "." & " " & "As discussed your Ops Specialist will be available to assist in the deployment of new counter terminals and is familiar with the instructions attached to this email.</p>" & vbCrLf & "<p>We will expect</p><p>" & vbCrLf & Counterpos & " " & "Counter Devices</p><p>" & vbCrLf & Foffice & " " & "Front Office Devices</p><p>" & vbCrLf & Boffice & " " & "Back Office Devices</p><p>" & vbCrLf & TAU & " " & "Devices connected to Teller Assist Units</P><p>" & vbCrLf & Camilla & " " & "Devices connected to Camilla units</P>" & vbCrLf & "<p>We will be replacing the computers in all positions <strong> apart from the POD workstation and any unused machines.</strong></p>"
parttwo = "Existing monitors will remain in place, as will keyboards on counter positions. For all non-counter positions we will provide a new keyboard and mouse." & vbCrLf & "<p>The impact to your branch should be minimal. Please expect it to take 10 - 15 minutes to deploy each non-counter position.</P><p> Counter positions will take longer as your Ops Specialist will be required to balance and transfer the funds from the till and return them once the new device is in place. We estimate this process will take 15-30 minutes.</font> </P>"
'
sig1 = "<p><font face = calibri> <size=10> NAME<br>"
sig2 = "<font face = calibri> <size=8>MDS Project Manager<br>"
sig3 = "<font face = calibri><size=10> Dell | Infrastructure Managed Services<br>"
sig4 = "<font face = calibri> <size=8>0141 202 5748<br>"
sig5 = "<font face = calibri> <size=8>EMAIL</p>"
'Open an instance of microsoft outlook, name it olk.
Dim olk As Outlook.Application
Set olk = CreateObject("Outlook.application")
'Create a new, empty outlook e-mail message
Dim olkMsg As Outlook.MailItem
Set olkMsg = olk.CreateItem(olMailItem)
'Put data from form into the new message
With olkMsg
Dim FILES As Office.FileDialog
Set FILES = Application.FileDialog(3)
FILES.AllowMultiSelect = True
' Show the dialog. If the method returns True, the user picked at least one file.
' If the method returns False, the user clicked Cancel.
If FILES.Show Then
MsgBox FILES.SelectedItems.Count & " file(s) were chosen."
' Display the full path to each file that was selected
Dim i As Integer
For i = 1 To FILES.SelectedItems.Count
MsgBox FILES.SelectedItems(i)
Next i
End If
Dim sPathAndFilename As Variant
Dim objOutlookAttach As Outlook.Attachment
Dim AttachME As Variant
FILES.SelectedItems = AttachME
Dim OlkRecip As Outlook.Recipient
.SentOnBehalfOfName = ("EMail")
Set OlkRecip = .Recipients.Add(emailprompt)
OlkRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("EMAil")
objOutlookRecip.Type = olCC
.Subject = "Site Visit" & " " & BRANCHNAME & " " & bid
.HTMLBody = partone & parttwo & sig1 & sig2 & sig3 & sig4 & sig5
For Each AttachME In .SelectedItems
' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments
End If
Next AttachME
.Send
End With
Set olk = Nothing
Set olkMsg = Nothing
Set OlkRecip = Nothing
' stop it displaying the error when its working
End Sub