Dear All
I have an excel vba listbox which lists all my mail subject lines (userform5.listbox1). I need to printout the selected mail as pdf via "dopdf". Please help me
Private Sub SEARCH_Click()
UserForm5.ListBox1.Clear
UserForm5.ListBox3.Clear
'UserForm5.ListBox2.Clear
Dim olMail As Variant
Dim aOutput() As Variant
Dim lCnt As Long
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim flInbox As folder
Dim MyOutLookApp As Object
Dim objfolder As folder
Dim myNamespace As Outlook.Namespace
Dim p1 As String
Dim f1 As String
Dim s1 As String
Dim f2 As String
Dim e1 As String
Dim cc As String
2: Set MyOutLookApp = CreateObject("Outlook.Application")
Dim myRecipient As Outlook.Recipient
Set myNamespace = MyOutLookApp.GetNamespace("MAPI")
'If UserForm5.OptionButton1 = True Then
Set myRecipient = myNamespace.CreateRecipient("(e-mail address removed)")
'ElseIf UserForm5.OptionButton2 = True Then
'Set myRecipient = myNamespace.CreateRecipient("(e-mail address removed)")
'End If
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox)
strFolderName = objInbox.Parent
Set objMailbox = objNamespace.Folders(strFolderName)
Dim filteredItems As Outlook.Items
Dim myFolder As Outlook.folder
Dim rand As String
Dim rand1 As String
Dim rand2 As String
Dim rand3 As String
Dim eventterm, randomization, version, urname As String
randomization = Sheets("Sheet3").Range("e29").Value
eventterm = Sheets("Template").Range("f4").Value
version = Sheets("Template").Range("o4").Value
urname = UserForm5.TextBox1.Text
If UserForm5.OptionButton5.Value = True Then
rand1 = "like" & "'%" & randomization & "%'"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand1
ElseIf UserForm5.OptionButton3.Value = True Then
rand1 = "like" & "'%" & randomization & "%'" & " " & "AND"
rand2 = "like" & "'%" & eventterm & "%'"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand1 & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand2
ElseIf UserForm5.OptionButton4.Value = True Then
rand1 = "like" & "'%" & randomization & "%'" & " " & "AND"
rand2 = "like" & "'%" & eventterm & "%'" & " " & "AND"
rand3 = "like" & "'%" & version & "%'"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand1 & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand2 & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand3
ElseIf UserForm5.OptionButton6.Value = True Then
rand1 = "like" & "'%" & randomization & "%'" & " " & "AND"
rand2 = "like" & "'%" & eventterm & "%'" & " " & "AND"
rand3 = "like" & "'%" & urname & "%'"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand1 & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand2 & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & rand3
ElseIf UserForm5.OptionButton7.Value = True Then
rand1 = "like" & "'%" & urname & "%'"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & rand1
End If
If UserForm5.OptionButton1 = True Then
Set filteredItems = objInbox.Items.Restrict(strFilter)
'****************************************************************
Else
If UserForm5.OptionButton2 = True Then
p1 = Sheets("Template").Range("A4") 'PROTOCOL
f1 = Sheets("Sheet3").Range("E54") 'CASE TYPE
s1 = Sheets("Sheet3").Range("E30") 'SITE ID
f2 = Sheets("Sheet3").Range("E53") 'MAILBOX NAME
e1 = Sheets("Template").Range("F4") 'EVENT TERM
'If f1 = "none" Then GoTo 112
'End If
Set objfolder = objMailbox.Folders("Mail").Folders(p1).Folders(f1).Folders(s1).Folders(f2)
'Set filteredItems = objfolder.Items.Restrict(strFilter)
Dim folder As folder
Dim n1 As Variable
Dim res As String
On Error Resume Next
cc = UserForm5.ListBox2.Value
Set objfolder = objMailbox.Folders("Mail").Folders(p1).Folders(f1).Folders(s1).Folders(f2).Folders(cc)
Set filteredItems = objfolder.Items.Restrict(strFilter)
End If
End If
'********************************************************************
If filteredItems.Count = 0 Then
MsgBox "No emails found"
Found = False
Else
Found = True
Dim nam As String
' this loop is optional, it displays the list of emails by subject.
For Each itm In filteredItems
UserForm5.ListBox1.AddItem (itm.Subject)
nam = itm.Subject
If nam Like "*Query Letter*" Then
UserForm5.ListBox3.AddItem ("QL")
UserForm5.ListBox3.AddItem ("")
ElseIf nam Like "*Confidential*" Then
UserForm5.ListBox3.AddItem ("Ack")
UserForm5.ListBox3.AddItem ("")
Else
UserForm5.ListBox3.AddItem ("")
UserForm5.ListBox3.AddItem ("")
End If
UserForm5.ListBox1.AddItem ("")
Next
'UserForm5.Show vbModeless
End If
'If the subject isn't found:
'If Not Found Then
'NoResults.Show
'Else
'Debug.Print "Found " & filteredItems.Count & " items."
'End If
'myOlApp.Quit
'Set myOlApp = Nothing
UserForm5.Label3.Caption = "Total No of Mails = " & filteredItems.Count
Exit Sub
112 MsgBox "Provide case type"
End Sub
I have an excel vba listbox which lists all my mail subject lines (userform5.listbox1). I need to printout the selected mail as pdf via "dopdf". Please help me
Private Sub SEARCH_Click()
UserForm5.ListBox1.Clear
UserForm5.ListBox3.Clear
'UserForm5.ListBox2.Clear
Dim olMail As Variant
Dim aOutput() As Variant
Dim lCnt As Long
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim flInbox As folder
Dim MyOutLookApp As Object
Dim objfolder As folder
Dim myNamespace As Outlook.Namespace
Dim p1 As String
Dim f1 As String
Dim s1 As String
Dim f2 As String
Dim e1 As String
Dim cc As String
2: Set MyOutLookApp = CreateObject("Outlook.Application")
Dim myRecipient As Outlook.Recipient
Set myNamespace = MyOutLookApp.GetNamespace("MAPI")
'If UserForm5.OptionButton1 = True Then
Set myRecipient = myNamespace.CreateRecipient("(e-mail address removed)")
'ElseIf UserForm5.OptionButton2 = True Then
'Set myRecipient = myNamespace.CreateRecipient("(e-mail address removed)")
'End If
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox)
strFolderName = objInbox.Parent
Set objMailbox = objNamespace.Folders(strFolderName)
Dim filteredItems As Outlook.Items
Dim myFolder As Outlook.folder
Dim rand As String
Dim rand1 As String
Dim rand2 As String
Dim rand3 As String
Dim eventterm, randomization, version, urname As String
randomization = Sheets("Sheet3").Range("e29").Value
eventterm = Sheets("Template").Range("f4").Value
version = Sheets("Template").Range("o4").Value
urname = UserForm5.TextBox1.Text
If UserForm5.OptionButton5.Value = True Then
rand1 = "like" & "'%" & randomization & "%'"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand1
ElseIf UserForm5.OptionButton3.Value = True Then
rand1 = "like" & "'%" & randomization & "%'" & " " & "AND"
rand2 = "like" & "'%" & eventterm & "%'"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand1 & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand2
ElseIf UserForm5.OptionButton4.Value = True Then
rand1 = "like" & "'%" & randomization & "%'" & " " & "AND"
rand2 = "like" & "'%" & eventterm & "%'" & " " & "AND"
rand3 = "like" & "'%" & version & "%'"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand1 & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand2 & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand3
ElseIf UserForm5.OptionButton6.Value = True Then
rand1 = "like" & "'%" & randomization & "%'" & " " & "AND"
rand2 = "like" & "'%" & eventterm & "%'" & " " & "AND"
rand3 = "like" & "'%" & urname & "%'"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand1 & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & rand2 & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & rand3
ElseIf UserForm5.OptionButton7.Value = True Then
rand1 = "like" & "'%" & urname & "%'"
strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:textdescription" & Chr(34) & rand1
End If
If UserForm5.OptionButton1 = True Then
Set filteredItems = objInbox.Items.Restrict(strFilter)
'****************************************************************
Else
If UserForm5.OptionButton2 = True Then
p1 = Sheets("Template").Range("A4") 'PROTOCOL
f1 = Sheets("Sheet3").Range("E54") 'CASE TYPE
s1 = Sheets("Sheet3").Range("E30") 'SITE ID
f2 = Sheets("Sheet3").Range("E53") 'MAILBOX NAME
e1 = Sheets("Template").Range("F4") 'EVENT TERM
'If f1 = "none" Then GoTo 112
'End If
Set objfolder = objMailbox.Folders("Mail").Folders(p1).Folders(f1).Folders(s1).Folders(f2)
'Set filteredItems = objfolder.Items.Restrict(strFilter)
Dim folder As folder
Dim n1 As Variable
Dim res As String
On Error Resume Next
cc = UserForm5.ListBox2.Value
Set objfolder = objMailbox.Folders("Mail").Folders(p1).Folders(f1).Folders(s1).Folders(f2).Folders(cc)
Set filteredItems = objfolder.Items.Restrict(strFilter)
End If
End If
'********************************************************************
If filteredItems.Count = 0 Then
MsgBox "No emails found"
Found = False
Else
Found = True
Dim nam As String
' this loop is optional, it displays the list of emails by subject.
For Each itm In filteredItems
UserForm5.ListBox1.AddItem (itm.Subject)
nam = itm.Subject
If nam Like "*Query Letter*" Then
UserForm5.ListBox3.AddItem ("QL")
UserForm5.ListBox3.AddItem ("")
ElseIf nam Like "*Confidential*" Then
UserForm5.ListBox3.AddItem ("Ack")
UserForm5.ListBox3.AddItem ("")
Else
UserForm5.ListBox3.AddItem ("")
UserForm5.ListBox3.AddItem ("")
End If
UserForm5.ListBox1.AddItem ("")
Next
'UserForm5.Show vbModeless
End If
'If the subject isn't found:
'If Not Found Then
'NoResults.Show
'Else
'Debug.Print "Found " & filteredItems.Count & " items."
'End If
'myOlApp.Quit
'Set myOlApp = Nothing
UserForm5.Label3.Caption = "Total No of Mails = " & filteredItems.Count
Exit Sub
112 MsgBox "Provide case type"
End Sub
Last edited: