how do I loop through a value list on form with vba reading all list entries

[trevor40]

Hi, I've been trying to put together a system that uses the file dialog boxto get a list of file names of pdf files, this file list is then used to create the list of attachments for outlook to use.

so far i can create a list of names as a seperate part.

I can sort of loop through only the selected items in the value list as a seperate part

I can create the automatic email and add a single file attachment or by adding several lines of outlookapp.Attachments.Add "..." I can hard code the file names of lots of files by they allways will change.

i have tried to incorporate the 2 options above but am having a hard time using the " with / end with loops i have.



I hope you can understand what I am looking for, if not let me know what other details I can provide.

[code below]

this works fine...

Private Sub Command40_Click() 'get file list
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Me.filelist.RowSource = ""
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.Title = "Select One or More Files"
If .Show = True Then
For Each varFile In .SelectedItems
Me.filelist.AddItem varFile
Next
Else
End If
End With
End Sub

this only sort of works to get all selected entries only...

Private Sub Command39_Click()
Dim sWhere As String ' Where condition
Dim lst As ListBox ' multiselect list box
Dim vItem As Variant ' items in listbox
Dim iLen As Integer ' length of string.
Dim swhare, t
Set lst = Me!filelist
For Each vItem In lst.ItemsSelected
If Not IsNull(vItem) Then
sWhere = sWhere & lst.ItemData(vItem)
End If
Next
Set lst = Nothing
End Sub


this works ok...

Dim t, db, rs, ttt, mail_to_list
t = MsgBox("Do you need to send an Email to the preselected list?", vbYesNo, "Send E-Mail Option")
If t = 6 Then
Set db = CurrentDb
Set rs = db.OpenRecordset("Employees")
rs.MoveFirst
Do While Not rs.EOF
If rs![Auto Receive Tracking Emails] = True Then
ttt = rs![E-Mail Address]
mail_to_list = mail_to_list + ttt & " ' ; '"
End If
rs.MoveNext
Loop
rs.Close
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myItem = myOlApp.CreateItem(olmailItem)
Set myAttachments = myItem.Attachments
With myItem

here is whare i nee to add all entries from the list

************
.Attachments.Add "C:\Documents and Settings\test\My Documents\default.rdp"
************

.To = mail_to_list
.Subject = "Logistics Movement"
.Body = "Please find attached report " & vbCrLf & vbCrLf & _
.Display
' SendKeys "%{s}", True
End With
End If
If t = 7 Then
Exit Sub
End If





regards
Trevor

[trevor40]

[QUOTE=trevor40;210886]Hi, I've been trying to put together a system that uses the file dialog boxto get a list of file names of pdf files, this file list is then used to create the list of attachments for outlook to use.

so far i can create a list of names as a seperate part.

I can sort of loop through only the selected items in the value list as a seperate part

I can create the automatic email and add a single file attachment or by adding several lines of outlookapp.Attachments.Add "..." I can hard code the file names of lots of files by they allways will change.

i have tried to incorporate the 2 options above but am having a hard time using the " with / end with loops i have.

I hope you can understand what I am looking for, if not let me know what other details I can provide.

[code below]

this works fine...

Private Sub Command40_Click() 'get file list
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Me.filelist.RowSource = ""
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.Title = "Select One or More Files"
If .Show = True Then
For Each varFile In .SelectedItems
Me.filelist.AddItem varFile
Next
Else
End If
End With
End Sub

this only sort of works to get all selected entries only...

Private Sub Command39_Click()
Dim sWhere As String ' Where condition
Dim lst As ListBox ' multiselect list box
Dim vItem As Variant ' items in listbox
Dim iLen As Integer ' length of string.
Dim swhare, t
Set lst = Me!filelist
For Each vItem In lst.ItemsSelected
If Not IsNull(vItem) Then
sWhere = sWhere & lst.ItemData(vItem)
End If
Next
Set lst = Nothing
End Sub


this works ok...

Dim t, db, rs, ttt, mail_to_list
t = MsgBox("Do you need to send an Email to the preselected list?", vbYesNo, "Send E-Mail Option")
If t = 6 Then
Set db = CurrentDb
Set rs = db.OpenRecordset("Employees")
rs.MoveFirst
Do While Not rs.EOF
If rs![Auto Receive Tracking Emails] = True Then
ttt = rs![E-Mail Address]
mail_to_list = mail_to_list + ttt & " ' ; '"
End If
rs.MoveNext
Loop
rs.Close
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myItem = myOlApp.CreateItem(olmailItem)
Set myAttachments = myItem.Attachments
With myItem

here is whare i nee to add all entries from the list

************
.Attachments.Add "C:\Documents and Settings\test\My Documents\default.rdp"
************

.To = mail_to_list
.Subject = "Logistics Movement"
.Body = "Please find attached report " & vbCrLf & vbCrLf & _
.Display
' SendKeys "%{s}", True
End With
End If
If t = 7 Then
Exit Sub
End If



this worked ok.
Dim sWhere As String ' Where condition
Dim lst As ListBox ' multiselect list box
Dim vItem As Variant ' items in listbox
Dim iLen As Integer ' length of string.
Dim swhare
Dim X As Integer
Dim t, db, rs, ttt, mail_to_list
Dim Y As Integer
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Me.filelist.RowSource = ""
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.Title = "Select One or More Files"
If .Show = True Then
For Each varFile In .SelectedItems
Me.filelist.AddItem varFile
Next
Else
End If
End With
X = Me.filelist.ListCount
For Y = 0 To X - 1
Me.filelist.Selected(Y) = True
Next Y
Set db = CurrentDb
Set rs = db.OpenRecordset("Employees")
rs.MoveFirst
Do While Not rs.EOF
If rs![Auto Receive Tracking Emails] = True Then
ttt = rs![E-Mail Address]
mail_to_list = mail_to_list + ttt & " ' ; '"
End If
rs.MoveNext
Loop
rs.Close
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myItem = myOlApp.CreateItem(olmailItem)
Set myAttachments = myItem.Attachments
Set lst = Me!filelist
With myItem
For Each vItem In lst.ItemsSelected
If Not IsNull(vItem) Then
ttt = lst.ItemData(vItem)
myItem.Attachments.Add ttt
End If
Next
Set lst = Nothing
myItem.To = mail_to_list
myItem.Subject = "Logistics Movement"
myItem.Body = "Please find attached report for an incomming consignment" & vbCrLf & vbCrLf & _
"This report is for Consignment # " & Me.Consignment_Note_Number myItem.Display
' SendKeys "%{s}", True
End With

[June7]

So this is resolved?

[trevor40]

yes it is, now onto my next problem, can you format the font of text in the above body of the email ?

[June7]

AFAIK, only with HTML code tags.